Feature #347 ยป scales-ppm-metis-4-5-parmetis-3-4.patch
| ppm-1.0.4/configure.ac 2017-09-23 15:33:22.802344068 -0400 | ||
|---|---|---|
|
[have_parmetis_c_bindings=no])
|
||
|
AM_CONDITIONAL([USE_PARMETIS],
|
||
|
[test x"$enable_parmetis" = xyes])
|
||
|
AS_IF([test x"$enable_parmetis" = xyes],
|
||
|
[AC_CHECK_TYPE([pmoptype_et], [have_parmetis_v3=no], [have_parmetis_v3=yes],
|
||
|
[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>])])
|
||
|
AM_CONDITIONAL([HAVE_PARMETIS_V3], [test x"$have_parmetis_v3" = xyes])
|
||
|
AC_SUBST([HAVE_PARMETIS_C_BINDINGS],["$have_parmetis_c_bindings"])
|
||
|
AM_SUBST_NOTMAKE([HAVE_PARMETIS_C_BINDINGS])
|
||
|
dnl
|
||
| ... | ... | |
|
[Provide wrapper for serial graph partitioners from METIS library @<:@default: auto@:>@])])
|
||
|
AS_IF([test x"$enable_metis" != xno],
|
||
|
[enable_metis=yes
|
||
|
# search metis/metis.h if parmetis is also used
|
||
|
AS_IF([test x"$enable_parmetis" = xyes],
|
||
|
[METIS_HEADER='metis/metis.h'],
|
||
|
[METIS_HEADER='metis.h'])
|
||
|
ACX_C_PACKAGE([metis],[$METIS_HEADER],,[[],[$MPI_C_INCLUDE]],
|
||
|
AC_CHECK_LIB([metis], [METIS_mCPartGraphKway], [have_metis_v4=yes],
|
||
|
[have_metis_v4=no], [-lm])
|
||
|
ACX_C_PACKAGE([metis],[metis.h],,[[],[$MPI_C_INCLUDE]],
|
||
|
[AC_MSG_WARN([Header for package METIS not found.])
|
||
|
enable_metis=no],
|
||
|
[METIS_PartGraphKway],[metis],ACX_M4_GENERATE_SUBSETS([[-lmetis],[-lm]],[ ]),,
|
||
| ... | ... | |
|
[METIS_C_INCLUDE= ; METIS_C_LIB=])
|
||
|
AM_CONDITIONAL([USE_METIS],
|
||
|
[test x"$enable_metis" = xyes])
|
||
|
AM_CONDITIONAL([HAVE_METIS_V4], [test x"$have_metis_v4" = xyes])
|
||
|
AC_SUBST([HAVE_METIS_C_BINDINGS],["$have_metis_c_bindings"])
|
||
|
AM_SUBST_NOTMAKE([HAVE_METIS_C_BINDINGS])
|
||
|
dnl
|
||
| ... | ... | |
|
[save_CFLAGS="$CFLAGS"
|
||
|
CFLAGS="$MPI_C_INCLUDE $PARMETIS_C_INCLUDE $METIS_C_INCLUDE $CFLAGS"
|
||
|
dnl determine the exact type used by parmetis/metis to represent node indices
|
||
|
AS_IF([test x"$enable_parmetis" = xyes],
|
||
|
[TJ_FIND_INTEGRAL_TYPE([idxtype],[PARMETIS_C_IDXTYPE],[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>])])
|
||
|
AS_IF([test x"$enable_metis" = xyes],
|
||
|
[TJ_FIND_INTEGRAL_TYPE([idxtype],[METIS_C_IDXTYPE],
|
||
|
[@%:@include <$METIS_HEADER>])],
|
||
|
[METIS_C_IDXTYPE=$PARMETIS_C_IDXTYPE])
|
||
|
[AC_CHECK_TYPE([idxtype], [metis_idxtype_name=idxtype],
|
||
|
[metis_idxtype_name=idx_t], [@%:@include <metis.h>])
|
||
|
TJ_FIND_INTEGRAL_TYPE([$metis_idxtype_name], [METIS_C_IDXTYPE],
|
||
|
[@%:@include <metis.h>])
|
||
|
AC_CHECK_TYPE([real_t], [have_metis_real_t=yes], [have_metis_real_t=no],
|
||
|
[@%:@include <metis.h>])
|
||
|
AS_IF([test x"$have_metis_real_t" = xyes],
|
||
|
[TJ_FIND_TYPE([real_t], [METIS_C_REAL_T], [@%:@include <metis.h>],
|
||
|
[float double])])])
|
||
|
AS_IF([test x"$enable_parmetis" = xyes],
|
||
|
[AC_CHECK_TYPE([idxtype], [parmetis_idxtype_name=idxtype],
|
||
|
[parmetis_idxtype_name=idx_t], [@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>])
|
||
|
TJ_FIND_INTEGRAL_TYPE([$parmetis_idxtype_name], [PARMETIS_C_IDXTYPE],
|
||
|
[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>])
|
||
|
AC_CHECK_TYPE([real_t], [have_parmetis_real_t=yes],
|
||
|
[have_parmetis_real_t=no], [@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>])
|
||
|
AS_IF([test x"$have_parmetis_real_t" = xyes],
|
||
|
[TJ_FIND_TYPE([real_t], [PARMETIS_C_REAL_T], [@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>], [float double])])],
|
||
|
[PARMETIS_C_IDXTYPE=$METIS_C_IDXTYPE
|
||
|
PARMETIS_C_REAL_T=$METIS_C_REAL_T])
|
||
|
# we require compatible types for METIS and ParMETIS
|
||
|
AS_IF([test x"$enable_parmetis" = xyes -a x"$enable_metis" = xyes],
|
||
|
[AS_IF([test "$METIS_C_IDXTYPE" != "$PARMETIS_C_IDXTYPE"],
|
||
|
[AS_IF([test "$METIS_C_IDXTYPE" != "$PARMETIS_C_IDXTYPE" -o \
|
||
|
"$PARMETIS_C_REAL_T" != "$METIS_C_REAL_T"],
|
||
|
[AC_MSG_FAILURE([Must use compatible versions of METIS and ParMETIS])])])
|
||
|
dnl next determine corresponding Fortran type kind
|
||
|
AS_IF([test x"$enable_parmetis" = xyes],
|
||
|
[ACX_FORTRAN_TYPE_KIND([integer],[METIS_FC_IDXTYPE_KIND],[idxtype],,
|
||
|
[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>],[METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])],
|
||
|
[ACX_FORTRAN_TYPE_KIND([integer],[METIS_FC_IDXTYPE_KIND],[idxtype],,
|
||
|
[@%:@include <$METIS_HEADER>],[METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])])
|
||
|
[AS_IF([test x"$parmetis_idxtype_name" = xidxtype],
|
||
|
[ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
|
||
|
[idxtype],,[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>], [METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])],
|
||
|
[ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
|
||
|
[idx_t],,[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>], [METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])])
|
||
|
AS_IF([test x"$have_parmetis_real_t" = xyes],
|
||
|
[ACX_FORTRAN_TYPE_KIND([real], [METIS_FC_REAL_T_KIND], [real_t],,
|
||
|
[@%:@include <mpi.h>
|
||
|
@%:@include <parmetis.h>], [METIS_FC_REAL_T_KIND=$acx_fortran_kind_subst])],
|
||
|
[METIS_FC_REAL_T_KIND=4])],
|
||
|
[AS_IF([test x"$metis_idxtype_name" = xidxtype],
|
||
|
[ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
|
||
|
[idxtype],, [@%:@include <metis.h>],
|
||
|
[METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])],
|
||
|
[ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
|
||
|
[idx_t],, [@%:@include <metis.h>],
|
||
|
[METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])])
|
||
|
AS_IF([test x"$have_metis_real_t" = xyes],
|
||
|
[ACX_FORTRAN_TYPE_KIND([real], [METIS_FC_REAL_T_KIND],
|
||
|
[real_t],,[@%:@include <metis.h>],
|
||
|
[METIS_FC_REAL_T_KIND=$acx_fortran_kind_subst])],
|
||
|
[METIS_FC_REAL_T_KIND=4])])
|
||
|
CFLAGS="$save_CFLAGS"
|
||
|
AS_IF([test x${METIS_FC_IDXTYPE_KIND+set} != xset],
|
||
|
[AC_MSG_FAILURE([Cannot determine type kind of ParMETIS index type.])])],
|
||
|
[METIS_FC_IDXTYPE_KIND=-1])
|
||
|
[AC_MSG_FAILURE([Cannot determine type kind of ParMETIS index type.])])
|
||
|
AS_IF([test x${METIS_FC_REAL_T_KIND+set} != xset],
|
||
|
[AC_MSG_FAILURE([Cannot determine type kind of ParMETIS real type.])])],
|
||
|
[METIS_FC_IDXTYPE_KIND=-1
|
||
|
METIS_FC_REAL_T_KIND=-1])
|
||
|
AC_SUBST([METIS_FC_IDXTYPE_KIND])
|
||
|
AC_SUBST([METIS_FC_REAL_T_KIND])
|
||
|
dnl
|
||
|
dnl adjust library paths for Fortran compiler
|
||
|
have_parmetis_fc_bindings=no
|
||
| ppm-1.0.4/include/f77/ppm.inc.in 2017-09-23 20:01:30.337264217 -0400 | ||
|---|---|---|
|
INTEGER PPM_IDX
|
||
|
PARAMETER (PPM_IDX=@METIS_FC_IDXTYPE_KIND@)
|
||
|
INTEGER PPM_REAL
|
||
|
PARAMETER (PPM_REAL=@METIS_FC_REAL_T_KIND@)
|
||
|
! Local Variables:
|
||
|
! mode: Fortran
|
||
| ppm-1.0.4/ppm.settings.in 2017-09-23 14:00:29.500877263 -0400 | ||
|---|---|---|
|
"cflags" : "@PARMETIS_C_INCLUDE@",
|
||
|
"found_fc" : "@HAVE_PARMETIS_FC_BINDINGS@",
|
||
|
"fclibs" : "@PARMETIS_FC_LIB@",
|
||
|
"fcidxkind" : "@METIS_FC_IDXTYPE_KIND@"
|
||
|
"fcidxkind" : "@METIS_FC_IDXTYPE_KIND@",
|
||
|
"fcrealkind": "@METIS_FC_REAL_T_KIND@"
|
||
|
},
|
||
|
"metis" : {
|
||
|
"found_c" : "@HAVE_METIS_C_BINDINGS@",
|
||
| ... | ... | |
|
"cflags" : "@METIS_C_INCLUDE@",
|
||
|
"found_fc" : "@HAVE_METIS_FC_BINDINGS@",
|
||
|
"fclibs" : "@METIS_FC_LIB@",
|
||
|
"fcidxkind" : "@METIS_FC_IDXTYPE_KIND@"
|
||
|
"fcidxkind" : "@METIS_FC_IDXTYPE_KIND@",
|
||
|
"fcrealkind": "@METIS_FC_REAL_T_KIND@"
|
||
|
},
|
||
|
"crypto" : {
|
||
|
"found_c" : "@HAVE_CRYPTO_C_BINDINGS@",
|
||
| ppm-1.0.4/src/Makefile.am 2017-09-21 11:31:31.806619041 -0400 | ||
|---|---|---|
|
if USE_PARMETIS
|
||
|
AM_FCFLAGS += $(FPP_DEFOPT)USE_PARMETIS
|
||
|
libscalesppm_la_SOURCES += ppm/ppm_graph_partition_mpi.f90 \
|
||
|
ppm/parmetis_wrap.c
|
||
|
libscalesppm_la_SOURCES += ppm/ppm_graph_partition_mpi.f90
|
||
|
if HAVE_PARMETIS_V3
|
||
|
AM_FCFLAGS += $(FPP_DEFOPT)HAVE_PARMETIS_V3
|
||
|
libscalesppm_la_SOURCES += ppm/parmetis_wrap.c
|
||
|
endif
|
||
|
endif
|
||
|
if USE_METIS
|
||
|
AM_FCFLAGS += $(FPP_DEFOPT)USE_METIS
|
||
|
if HAVE_METIS_V4
|
||
|
AM_FCFLAGS += $(FPP_DEFOPT)HAVE_METIS_V4
|
||
|
endif
|
||
|
libscalesppm_la_SOURCES += ppm/ppm_graph_partition_serial.f90
|
||
|
endif
|
||
|
if USE_FC_NETCDF
|
||
| ppm-1.0.4/src/ppm/ppm_graph_partition_mpi.f90 2017-09-25 01:16:55.319543232 -0400 | ||
|---|---|---|
|
!> This is currently only a convenient wrapper of ParMeTis, other
|
||
|
!! heuristics are to follow later.
|
||
|
MODULE ppm_graph_partition_mpi
|
||
|
USE iso_c_binding, ONLY: c_int, c_float
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
USE iso_c_binding, ONLY: c_int
|
||
|
#endif
|
||
|
USE iso_c_binding, ONLY: c_ptr, c_null_ptr, c_loc
|
||
|
USE ppm_base, ONLY: abort_ppm
|
||
|
#ifdef USE_MPI_MOD
|
||
|
USE mpi
|
||
| ... | ... | |
|
INTERFACE
|
||
|
SUBROUTINE parmetis_v3_partkway(vtxdist, xadj, adjncy, vwgt, adjwgt, &
|
||
|
wgtflag, numflag, ncon, nparts, tpwgts, ubvec, options, edgecut, &
|
||
|
part, comm)
|
||
|
USE iso_c_binding, ONLY: c_int, c_float
|
||
|
part, comm) BIND(C)
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
USE iso_c_binding, ONLY: c_int
|
||
|
#endif
|
||
|
USE iso_c_binding, ONLY: c_ptr
|
||
|
IMPORT :: ppm_idx
|
||
|
INTEGER(ppm_idx), INTENT(in) :: vtxdist(*), xadj(*), adjncy(*), &
|
||
|
vwgt(*), adjwgt(*)
|
||
|
IMPORT :: ppm_real
|
||
|
INTEGER(ppm_idx), INTENT(in) :: vtxdist(*), xadj(*), adjncy(*)
|
||
|
TYPE(c_ptr), VALUE, INTENT(in) :: vwgt, adjwgt
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
INTEGER(c_int), INTENT(in) :: wgtflag, numflag, ncon, nparts, options(*)
|
||
|
REAL(c_float), INTENT(in) :: tpwgts(ncon, nparts), ubvec(ncon)
|
||
|
#else
|
||
|
INTEGER(ppm_idx), INTENT(in) :: wgtflag, numflag, ncon, nparts, options(*)
|
||
|
#endif
|
||
|
TYPE(c_ptr), VALUE, INTENT(in) :: tpwgts
|
||
|
REAL(ppm_real), INTENT(in) :: ubvec(ncon)
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
INTEGER(c_int), INTENT(out) :: edgecut
|
||
|
#else
|
||
|
INTEGER(ppm_idx), INTENT(out) :: edgecut
|
||
|
#endif
|
||
|
INTEGER(ppm_idx), INTENT(out) :: part(*)
|
||
|
INTEGER, INTENT(in) :: comm
|
||
|
END SUBROUTINE parmetis_v3_partkway
|
||
| ... | ... | |
|
INTEGER(ppm_idx), INTENT(in) :: edge_lists(:)
|
||
|
INTEGER(ppm_idx), INTENT(out) :: partition_out(*)
|
||
|
INTEGER, OPTIONAL, INTENT(in) :: comm
|
||
|
INTEGER, OPTIONAL, INTENT(in) :: num_partitions
|
||
|
REAL(c_float), OPTIONAL, INTENT(in) :: balance(:, :)
|
||
|
INTEGER, OPTIONAL, INTENT(in) :: num_vertex_weights
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: vertex_weights(:)
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: edge_weights(:)
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
INTEGER(c_int), OPTIONAL, INTENT(in) :: num_partitions
|
||
|
#else
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: num_partitions
|
||
|
#endif
|
||
|
REAL(ppm_real), OPTIONAL, TARGET, INTENT(in) :: balance(:, :)
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
INTEGER(c_int), OPTIONAL, INTENT(in) :: num_vertex_weights
|
||
|
#else
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: num_vertex_weights
|
||
|
#endif
|
||
|
INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: vertex_weights(:)
|
||
|
INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: edge_weights(:)
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
INTEGER(c_int) :: wgtflag
|
||
|
#else
|
||
|
INTEGER(ppm_idx) :: wgtflag
|
||
|
#endif
|
||
|
INTEGER :: part_comm, comm_size, comm_rank, ierror, i, ierror_
|
||
|
INTEGER, ALLOCATABLE :: vtxdist(:)
|
||
|
INTEGER(c_int) :: metis_options(0:2), edge_cut, num_parts
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
INTEGER(c_int) :: metis_options(0:2), edge_cut, ncon, num_parts
|
||
|
#else
|
||
|
INTEGER(ppm_idx) :: metis_options(0:2), edge_cut, ncon, num_parts
|
||
|
#endif
|
||
|
INTEGER :: msg_len
|
||
|
CHARACTER(len=mpi_max_error_string) :: msg
|
||
|
INTEGER(ppm_idx) :: dummy_weights(1)
|
||
|
REAL(c_float) :: dummy_balance(1)
|
||
|
TYPE(c_ptr) :: vwgt, adjwgt
|
||
|
TYPE(c_ptr) :: tpwgts
|
||
|
#ifndef HAVE_PARMETIS_V3
|
||
|
REAL(ppm_real), ALLOCATABLE, TARGET :: tpwgts_balance(:, :)
|
||
|
#endif
|
||
|
IF (PRESENT(comm)) THEN; part_comm = comm; ELSE; part_comm = mpi_comm_world
|
||
|
END IF
|
||
| ... | ... | |
|
wgtflag = 0
|
||
|
IF (PRESENT(vertex_weights)) wgtflag = 2
|
||
|
IF (PRESENT(edge_weights)) wgtflag = IOR(wgtflag, 1)
|
||
|
IF (PRESENT(num_vertex_weights)) THEN
|
||
|
ncon = num_vertex_weights
|
||
|
ELSE
|
||
|
ncon = 1
|
||
|
END IF
|
||
|
IF (PRESENT(num_partitions)) THEN
|
||
|
num_parts = num_partitions
|
||
|
ELSE
|
||
|
num_parts = comm_size
|
||
|
END IF
|
||
|
metis_options(0) = 0
|
||
|
IF (PRESENT(balance) .AND. PRESENT(edge_weights)) THEN
|
||
|
CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
|
||
|
vertex_weights, edge_weights, wgtflag, 1, num_vertex_weights, &
|
||
|
num_parts, balance, (/ REAL(1.05, c_float) /), metis_options, &
|
||
|
edge_cut, partition_out, part_comm)
|
||
|
ELSE IF(PRESENT(balance)) THEN
|
||
|
CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
|
||
|
vertex_weights, dummy_weights, wgtflag, 1, num_vertex_weights, &
|
||
|
num_parts, balance, (/ REAL(1.05, c_float) /), metis_options, &
|
||
|
edge_cut, partition_out, part_comm)
|
||
|
ELSE ! neighter balance nor edge_weights present
|
||
|
CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
|
||
|
vertex_weights, dummy_weights, wgtflag, 1, num_vertex_weights, &
|
||
|
num_parts, dummy_balance, (/ REAL(1.05, c_float) /), metis_options, &
|
||
|
edge_cut, partition_out, part_comm)
|
||
|
IF (PRESENT(vertex_weights)) THEN
|
||
|
vwgt = c_loc(vertex_weights(1))
|
||
|
ELSE
|
||
|
vwgt = c_null_ptr
|
||
|
END IF
|
||
|
IF (PRESENT(edge_weights)) THEN
|
||
|
adjwgt = c_loc(edge_weights(1))
|
||
|
ELSE
|
||
|
adjwgt = c_null_ptr
|
||
|
END IF
|
||
|
IF (PRESENT(balance)) THEN
|
||
|
tpwgts = c_loc(balance(1, 1))
|
||
|
ELSE
|
||
|
#ifdef HAVE_PARMETIS_V3
|
||
|
tpwgts = c_null_ptr
|
||
|
#else
|
||
|
ALLOCATE(tpwgts_balance(ncon, num_parts))
|
||
|
tpwgts_balance = 1 / num_parts
|
||
|
tpwgts = c_loc(tpwgts_balance(1, 1))
|
||
|
#endif
|
||
|
END IF
|
||
|
CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
|
||
|
vwgt, adjwgt, wgtflag, 1, ncon, num_parts, tpwgts, &
|
||
|
(/ REAL(1.05, ppm_real) /), metis_options, edge_cut, &
|
||
|
partition_out, part_comm)
|
||
|
END SUBROUTINE graph_partition_parmetis
|
||
|
END MODULE ppm_graph_partition_mpi
|
||
|
!
|
||
| ppm-1.0.4/src/ppm/ppm_graph_partition_serial.f90 2017-09-24 03:12:12.523645746 -0400 | ||
|---|---|---|
|
!
|
||
|
!> perform partitioning of graph from serial code
|
||
|
MODULE ppm_graph_partition_serial
|
||
|
USE iso_c_binding, ONLY: c_int, c_float
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
USE iso_c_binding, ONLY: c_int
|
||
|
#endif
|
||
|
USE iso_c_binding, ONLY: c_ptr, c_null_ptr, c_loc
|
||
|
USE ppm_base, ONLY: assertion
|
||
|
USE ppm_extents, ONLY: extent
|
||
|
USE ppm_graph_csr, ONLY: graph_csr, num_nodes
|
||
| ... | ... | |
|
IMPLICIT NONE
|
||
|
PRIVATE
|
||
|
#include <ppm.inc>
|
||
|
EXTERNAL :: METIS_mCPartGraphKway
|
||
|
EXTERNAL :: METIS_PartGraphKway
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
INTERFACE
|
||
|
SUBROUTINE metis_mcpartgraphkway(nvtxs, ncon, xadj, adjncy, vwgt, adjwgt, &
|
||
|
wgtflag, numflag, nparts, rubvec, options, edgecut, part) BIND(C)
|
||
|
USE iso_c_binding, ONLY: c_int, c_ptr
|
||
|
IMPORT :: ppm_idx
|
||
|
IMPORT :: ppm_real
|
||
|
INTEGER(ppm_idx), INTENT(in) :: xadj(*), adjncy(*)
|
||
|
TYPE(c_ptr), VALUE, INTENT(in) :: vwgt, adjwgt
|
||
|
INTEGER(c_int), INTENT(in) :: nvtxs, wgtflag, numflag, ncon, nparts, options(*)
|
||
|
REAL(ppm_real), INTENT(in) :: rubvec(ncon)
|
||
|
INTEGER(c_int), INTENT(out) :: edgecut
|
||
|
INTEGER(ppm_idx), INTENT(out) :: part(*)
|
||
|
END SUBROUTINE metis_mcpartgraphkway
|
||
|
END INTERFACE
|
||
|
#else
|
||
|
INTERFACE
|
||
|
SUBROUTINE metis_setdefaultoptions(options) BIND(C)
|
||
|
IMPORT :: ppm_idx
|
||
|
INTEGER(ppm_idx), INTENT(out) :: options(*)
|
||
|
END SUBROUTINE metis_setdefaultoptions
|
||
|
END INTERFACE
|
||
|
#endif
|
||
|
INTERFACE
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
SUBROUTINE metis_partgraphkway(nvtxs, xadj, adjncy, vwgt, adjwgt, &
|
||
|
wgtflag, numflag, nparts, options, edgecut, part) BIND(C)
|
||
|
USE iso_c_binding, ONLY: c_int
|
||
|
#else
|
||
|
SUBROUTINE metis_partgraphkway(nvtxs, ncon, xadj, adjncy, vwgt, vsize, &
|
||
|
adjwgt, nparts, tpwgts, ubvec, options, edgecut, part) BIND(C)
|
||
|
#endif
|
||
|
USE iso_c_binding, ONLY: c_ptr
|
||
|
IMPORT :: ppm_idx
|
||
|
INTEGER(ppm_idx), INTENT(in) :: xadj(*), adjncy(*)
|
||
|
TYPE(c_ptr), VALUE, INTENT(in) :: vwgt, adjwgt
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
INTEGER(c_int), INTENT(in) :: nvtxs, wgtflag, numflag, nparts, options(*)
|
||
|
#else
|
||
|
INTEGER(ppm_idx), INTENT(in) :: nvtxs, ncon, nparts, options(*)
|
||
|
TYPE(c_ptr), VALUE, INTENT(in) :: vsize
|
||
|
TYPE(c_ptr), VALUE, INTENT(in) :: tpwgts, ubvec
|
||
|
#endif
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
INTEGER(c_int), INTENT(out) :: edgecut
|
||
|
#else
|
||
|
INTEGER(ppm_idx), INTENT(out) :: edgecut
|
||
|
#endif
|
||
|
INTEGER(ppm_idx), INTENT(out) :: part(*)
|
||
|
END SUBROUTINE metis_partgraphkway
|
||
|
END INTERFACE
|
||
|
PUBLIC :: graph_partition_metis
|
||
|
INTERFACE graph_partition_metis
|
||
|
MODULE PROCEDURE graph_partition_metis_base
|
||
| ... | ... | |
|
SUBROUTINE graph_partition_metis_base(num_vertices, edge_list_lens, &
|
||
|
edge_lists, partition_out, num_partitions, &
|
||
|
imbalance_tolerance, vertex_weights, edge_weights)
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
INTEGER(c_int), INTENT(in) :: num_vertices
|
||
|
#else
|
||
|
INTEGER(ppm_idx), INTENT(in) :: num_vertices
|
||
|
#endif
|
||
|
INTEGER(ppm_idx), INTENT(in) :: edge_list_lens(:)
|
||
|
INTEGER(ppm_idx), INTENT(in) :: edge_lists(:)
|
||
|
INTEGER(ppm_idx), INTENT(out) :: partition_out(:)
|
||
|
INTEGER, INTENT(in) :: num_partitions
|
||
|
REAL(c_float), OPTIONAL, INTENT(in) :: imbalance_tolerance(:)
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: vertex_weights(*)
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: edge_weights(*)
|
||
|
INTEGER(ppm_idx) :: vw_dummy(1), ew_dummy(1)
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
INTEGER(c_int), INTENT(in) :: num_partitions
|
||
|
#else
|
||
|
INTEGER(ppm_idx), INTENT(in) :: num_partitions
|
||
|
#endif
|
||
|
REAL(ppm_real), OPTIONAL, TARGET, INTENT(in) :: imbalance_tolerance(:)
|
||
|
INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: vertex_weights(*)
|
||
|
INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: edge_weights(*)
|
||
|
TYPE(c_ptr) :: vwgt, adjwgt
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
INTEGER(c_int) :: wgtflag
|
||
|
INTEGER(c_int) :: metis_options(0:4), edge_cut
|
||
|
metis_options(0) = 0
|
||
|
metis_options(1:4) = 0
|
||
|
#else
|
||
|
TYPE(c_ptr) :: vsize = c_null_ptr
|
||
|
TYPE(c_ptr) :: tpwgts = c_null_ptr, ubvec
|
||
|
INTEGER(ppm_idx) :: metis_options(0:39), edge_cut
|
||
|
CALL metis_setdefaultoptions(metis_options)
|
||
|
! METIS_OPTION_NUMBERING : use Fortran-style
|
||
|
metis_options(17) = 1
|
||
|
#endif
|
||
|
IF (PRESENT(vertex_weights)) THEN
|
||
|
vwgt = c_loc(vertex_weights(1))
|
||
|
ELSE
|
||
|
vwgt = c_null_ptr
|
||
|
END IF
|
||
|
IF (PRESENT(edge_weights)) THEN
|
||
|
adjwgt = c_loc(edge_weights(1))
|
||
|
ELSE
|
||
|
adjwgt = c_null_ptr
|
||
|
END IF
|
||
|
IF (PRESENT(imbalance_tolerance)) THEN
|
||
|
CALL assertion(PRESENT(vertex_weights), line=__LINE__, &
|
||
|
source=__FILE__, &
|
||
|
msg="when imbalance_tolerance is provided, vertex weights&
|
||
|
& are also required")
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
wgtflag = MERGE(1, 0, PRESENT(edge_weights))
|
||
|
IF (PRESENT(edge_weights)) THEN
|
||
|
CALL metis_mCPartGraphKway(INT(num_vertices, c_int), &
|
||
|
INT(SIZE(imbalance_tolerance), c_int), &
|
||
|
edge_list_lens, edge_lists, &
|
||
|
vertex_weights, edge_weights, wgtflag, 1_c_int, &
|
||
|
INT(num_partitions, c_int), &
|
||
|
imbalance_tolerance, metis_options, edge_cut, partition_out)
|
||
|
ELSE
|
||
|
CALL metis_mCPartGraphKway(INT(num_vertices, c_int), &
|
||
|
INT(SIZE(imbalance_tolerance), c_int), &
|
||
|
edge_list_lens, edge_lists, &
|
||
|
vertex_weights, ew_dummy, wgtflag, 1_c_int, &
|
||
|
INT(num_partitions, c_int), &
|
||
|
imbalance_tolerance, metis_options, edge_cut, partition_out)
|
||
|
END IF
|
||
|
CALL metis_mcpartgraphkway(num_vertices, &
|
||
|
INT(SIZE(imbalance_tolerance), c_int), edge_list_lens, edge_lists, &
|
||
|
vwgt, adjwgt, wgtflag, 1, num_partitions, imbalance_tolerance, &
|
||
|
metis_options, edge_cut, partition_out)
|
||
|
#else
|
||
|
ubvec = c_loc(imbalance_tolerance(1))
|
||
|
#endif
|
||
|
ELSE
|
||
|
#ifdef HAVE_METIS_V4
|
||
|
wgtflag = MERGE(2, 0, PRESENT(vertex_weights))
|
||
|
wgtflag = IOR(wgtflag, MERGE(1, 0, PRESENT(edge_weights)))
|
||
|
SELECT CASE(wgtflag)
|
||
|
CASE(0)
|
||
|
CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
|
||
|
edge_list_lens, edge_lists, &
|
||
|
vw_dummy, ew_dummy, wgtflag, INT(1, c_int), &
|
||
|
INT(num_partitions, c_int), &
|
||
|
metis_options, edge_cut, partition_out)
|
||
|
CASE(1)
|
||
|
CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
|
||
|
edge_list_lens, edge_lists, &
|
||
|
vw_dummy, edge_weights, wgtflag, INT(1, c_int), &
|
||
|
INT(num_partitions, c_int), &
|
||
|
metis_options, edge_cut, partition_out)
|
||
|
CASE(2)
|
||
|
CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
|
||
|
edge_list_lens, edge_lists, &
|
||
|
vertex_weights, ew_dummy, wgtflag, INT(1, c_int), &
|
||
|
INT(num_partitions, c_int), &
|
||
|
metis_options, edge_cut, partition_out)
|
||
|
CASE(3)
|
||
|
CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
|
||
|
edge_list_lens, edge_lists, &
|
||
|
vertex_weights, edge_weights, wgtflag, INT(1, c_int), &
|
||
|
INT(num_partitions, c_int), &
|
||
|
metis_options, edge_cut, partition_out)
|
||
|
END SELECT
|
||
|
CALL metis_partgraphkway(num_vertices, edge_list_lens, edge_lists, vwgt, &
|
||
|
adjwgt, wgtflag, 1, num_partitions, metis_options, edge_cut, &
|
||
|
partition_out)
|
||
|
#else
|
||
|
ubvec = c_null_ptr
|
||
|
#endif
|
||
|
END IF
|
||
|
#ifndef HAVE_METIS_V4
|
||
|
CALL metis_partgraphkway(num_vertices, 1, edge_list_lens, &
|
||
|
edge_lists, vwgt, vsize, adjwgt, num_partitions, tpwgts, ubvec, &
|
||
|
metis_options, edge_cut, partition_out)
|
||
|
#endif
|
||
|
END SUBROUTINE graph_partition_metis_base
|
||
|
SUBROUTINE graph_partition_metis_csr(partition, graph, num_partitions, &
|
||
| ... | ... | |
|
TYPE(partition_assignment), INTENT(out) :: partition
|
||
|
TYPE(graph_csr), INTENT(in) :: graph
|
||
|
INTEGER, INTENT(in) :: num_partitions
|
||
|
REAL(c_float), INTENT(in) :: imbalance_tolerance(:)
|
||
|
REAL(ppm_real), INTENT(in) :: imbalance_tolerance(:)
|
||
|
INTEGER(ppm_idx), INTENT(in) :: vertex_weights(:,:)
|
||
|
INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: edge_weights(:)
|
||