Project

General

Profile

Feature #347 ยป scales-ppm-metis-4-5-parmetis-3-4.patch

Matthew Krupcale, 09/26/2017 03:13 AM

View differences:

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(:)
    (1-1/1)