scales-ppm-metis-4-5-parmetis-3-4.patch

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

Download (22.7 kB)

ppm-1.0.4/configure.ac 2017-09-23 15:33:22.802344068 -0400
584 584
     [have_parmetis_c_bindings=no])
585 585
AM_CONDITIONAL([USE_PARMETIS],
586 586
  [test x"$enable_parmetis" = xyes])
587
AS_IF([test x"$enable_parmetis" = xyes],
588
  [AC_CHECK_TYPE([pmoptype_et], [have_parmetis_v3=no], [have_parmetis_v3=yes],
589
    [@%:@include <mpi.h>
590
@%:@include <parmetis.h>])])
591
AM_CONDITIONAL([HAVE_PARMETIS_V3], [test x"$have_parmetis_v3" = xyes])
587 592
AC_SUBST([HAVE_PARMETIS_C_BINDINGS],["$have_parmetis_c_bindings"])
588 593
AM_SUBST_NOTMAKE([HAVE_PARMETIS_C_BINDINGS])
589 594
dnl
......
592 597
     [Provide wrapper for serial graph partitioners from METIS library @<:@default: auto@:>@])])
593 598
AS_IF([test x"$enable_metis" != xno],
594 599
  [enable_metis=yes
595
# search metis/metis.h if parmetis is also used
596
   AS_IF([test x"$enable_parmetis" = xyes],
597
     [METIS_HEADER='metis/metis.h'],
598
     [METIS_HEADER='metis.h'])
599
   ACX_C_PACKAGE([metis],[$METIS_HEADER],,[[],[$MPI_C_INCLUDE]],
600
   AC_CHECK_LIB([metis], [METIS_mCPartGraphKway], [have_metis_v4=yes],
601
     [have_metis_v4=no], [-lm])
602
   ACX_C_PACKAGE([metis],[metis.h],,[[],[$MPI_C_INCLUDE]],
600 603
     [AC_MSG_WARN([Header for package METIS not found.])
601 604
      enable_metis=no],
602 605
     [METIS_PartGraphKway],[metis],ACX_M4_GENERATE_SUBSETS([[-lmetis],[-lm]],[ ]),,
......
607 610
  [METIS_C_INCLUDE= ; METIS_C_LIB=])
608 611
AM_CONDITIONAL([USE_METIS],
609 612
  [test x"$enable_metis" = xyes])
613
AM_CONDITIONAL([HAVE_METIS_V4], [test x"$have_metis_v4" = xyes])
610 614
AC_SUBST([HAVE_METIS_C_BINDINGS],["$have_metis_c_bindings"])
611 615
AM_SUBST_NOTMAKE([HAVE_METIS_C_BINDINGS])
612 616
dnl
......
614 618
  [save_CFLAGS="$CFLAGS"
615 619
   CFLAGS="$MPI_C_INCLUDE $PARMETIS_C_INCLUDE $METIS_C_INCLUDE $CFLAGS"
616 620
dnl determine the exact type used by parmetis/metis to represent node indices
617
   AS_IF([test x"$enable_parmetis" = xyes],
618
     [TJ_FIND_INTEGRAL_TYPE([idxtype],[PARMETIS_C_IDXTYPE],[@%:@include <mpi.h>
619
@%:@include <parmetis.h>])])
620 621
   AS_IF([test x"$enable_metis" = xyes],
621
     [TJ_FIND_INTEGRAL_TYPE([idxtype],[METIS_C_IDXTYPE],
622
        [@%:@include <$METIS_HEADER>])],
623
     [METIS_C_IDXTYPE=$PARMETIS_C_IDXTYPE])
622
     [AC_CHECK_TYPE([idxtype], [metis_idxtype_name=idxtype],
623
        [metis_idxtype_name=idx_t], [@%:@include <metis.h>])
624
      TJ_FIND_INTEGRAL_TYPE([$metis_idxtype_name], [METIS_C_IDXTYPE],
625
        [@%:@include <metis.h>])
626
      AC_CHECK_TYPE([real_t], [have_metis_real_t=yes], [have_metis_real_t=no],
627
        [@%:@include <metis.h>])
628
      AS_IF([test x"$have_metis_real_t" = xyes],
629
        [TJ_FIND_TYPE([real_t], [METIS_C_REAL_T], [@%:@include <metis.h>],
630
	   [float double])])])
631
   AS_IF([test x"$enable_parmetis" = xyes],
632
     [AC_CHECK_TYPE([idxtype], [parmetis_idxtype_name=idxtype],
633
        [parmetis_idxtype_name=idx_t], [@%:@include <mpi.h>
634
@%:@include <parmetis.h>])
635
      TJ_FIND_INTEGRAL_TYPE([$parmetis_idxtype_name], [PARMETIS_C_IDXTYPE],
636
      [@%:@include <mpi.h>
637
@%:@include <parmetis.h>])
638
      AC_CHECK_TYPE([real_t], [have_parmetis_real_t=yes],
639
        [have_parmetis_real_t=no], [@%:@include <mpi.h>
640
@%:@include <parmetis.h>])
641
      AS_IF([test x"$have_parmetis_real_t" = xyes],
642
        [TJ_FIND_TYPE([real_t], [PARMETIS_C_REAL_T], [@%:@include <mpi.h>
643
@%:@include <parmetis.h>], [float double])])],
644
     [PARMETIS_C_IDXTYPE=$METIS_C_IDXTYPE
645
      PARMETIS_C_REAL_T=$METIS_C_REAL_T])
624 646
   # we require compatible types for METIS and ParMETIS
625 647
   AS_IF([test x"$enable_parmetis" = xyes -a x"$enable_metis" = xyes],
626
     [AS_IF([test "$METIS_C_IDXTYPE" != "$PARMETIS_C_IDXTYPE"],
648
     [AS_IF([test "$METIS_C_IDXTYPE" != "$PARMETIS_C_IDXTYPE" -o \
649
             "$PARMETIS_C_REAL_T" != "$METIS_C_REAL_T"],
627 650
        [AC_MSG_FAILURE([Must use compatible versions of METIS and ParMETIS])])])
628 651
   dnl next determine corresponding Fortran type kind
629 652
   AS_IF([test x"$enable_parmetis" = xyes],
630
     [ACX_FORTRAN_TYPE_KIND([integer],[METIS_FC_IDXTYPE_KIND],[idxtype],,
631
[@%:@include <mpi.h>
632
@%:@include <parmetis.h>],[METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])],
633
     [ACX_FORTRAN_TYPE_KIND([integer],[METIS_FC_IDXTYPE_KIND],[idxtype],,
634
[@%:@include <$METIS_HEADER>],[METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])])
653
     [AS_IF([test x"$parmetis_idxtype_name" = xidxtype],
654
        [ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
655
           [idxtype],,[@%:@include <mpi.h>
656
@%:@include <parmetis.h>], [METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])],
657
        [ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
658
           [idx_t],,[@%:@include <mpi.h>
659
@%:@include <parmetis.h>], [METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])])
660
      AS_IF([test x"$have_parmetis_real_t" = xyes],
661
        [ACX_FORTRAN_TYPE_KIND([real], [METIS_FC_REAL_T_KIND], [real_t],,
662
        [@%:@include <mpi.h>
663
@%:@include <parmetis.h>], [METIS_FC_REAL_T_KIND=$acx_fortran_kind_subst])],
664
        [METIS_FC_REAL_T_KIND=4])],
665
     [AS_IF([test x"$metis_idxtype_name" = xidxtype],
666
        [ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
667
           [idxtype],, [@%:@include <metis.h>],
668
           [METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])],
669
	[ACX_FORTRAN_TYPE_KIND([integer], [METIS_FC_IDXTYPE_KIND],
670
           [idx_t],, [@%:@include <metis.h>],
671
           [METIS_FC_IDXTYPE_KIND=$acx_fortran_kind_subst])])
672
      AS_IF([test x"$have_metis_real_t" = xyes],
673
        [ACX_FORTRAN_TYPE_KIND([real], [METIS_FC_REAL_T_KIND],
674
           [real_t],,[@%:@include <metis.h>],
675
	   [METIS_FC_REAL_T_KIND=$acx_fortran_kind_subst])],
676
        [METIS_FC_REAL_T_KIND=4])])
635 677
   CFLAGS="$save_CFLAGS"
636 678
   AS_IF([test x${METIS_FC_IDXTYPE_KIND+set} != xset],
637
     [AC_MSG_FAILURE([Cannot determine type kind of ParMETIS index type.])])],
638
  [METIS_FC_IDXTYPE_KIND=-1])
679
     [AC_MSG_FAILURE([Cannot determine type kind of ParMETIS index type.])])
680
   AS_IF([test x${METIS_FC_REAL_T_KIND+set} != xset],
681
     [AC_MSG_FAILURE([Cannot determine type kind of ParMETIS real type.])])],
682
  [METIS_FC_IDXTYPE_KIND=-1
683
   METIS_FC_REAL_T_KIND=-1])
639 684
AC_SUBST([METIS_FC_IDXTYPE_KIND])
685
AC_SUBST([METIS_FC_REAL_T_KIND])
640 686
dnl
641 687
dnl adjust library paths for Fortran compiler
642 688
have_parmetis_fc_bindings=no
ppm-1.0.4/include/f77/ppm.inc.in 2017-09-23 20:01:30.337264217 -0400
49 49

  
50 50
      INTEGER PPM_IDX
51 51
      PARAMETER (PPM_IDX=@METIS_FC_IDXTYPE_KIND@)
52
      INTEGER PPM_REAL
53
      PARAMETER (PPM_REAL=@METIS_FC_REAL_T_KIND@)
52 54

  
53 55
! Local Variables:
54 56
! mode: Fortran
ppm-1.0.4/ppm.settings.in 2017-09-23 14:00:29.500877263 -0400
58 58
                "cflags"    : "@PARMETIS_C_INCLUDE@",
59 59
                "found_fc"  : "@HAVE_PARMETIS_FC_BINDINGS@",
60 60
                "fclibs"    : "@PARMETIS_FC_LIB@",
61
                "fcidxkind" : "@METIS_FC_IDXTYPE_KIND@"
61
                "fcidxkind" : "@METIS_FC_IDXTYPE_KIND@",
62
                "fcrealkind": "@METIS_FC_REAL_T_KIND@"
62 63
            },
63 64
            "metis" : {
64 65
                "found_c"   : "@HAVE_METIS_C_BINDINGS@",
......
66 67
                "cflags"    : "@METIS_C_INCLUDE@",
67 68
                "found_fc"  : "@HAVE_METIS_FC_BINDINGS@",
68 69
                "fclibs"    : "@METIS_FC_LIB@",
69
                "fcidxkind" : "@METIS_FC_IDXTYPE_KIND@"
70
                "fcidxkind" : "@METIS_FC_IDXTYPE_KIND@",
71
                "fcrealkind": "@METIS_FC_REAL_T_KIND@"
70 72
            },
71 73
            "crypto" : {
72 74
                "found_c"   : "@HAVE_CRYPTO_C_BINDINGS@",
ppm-1.0.4/src/Makefile.am 2017-09-21 11:31:31.806619041 -0400
309 309

  
310 310
if USE_PARMETIS
311 311
AM_FCFLAGS += $(FPP_DEFOPT)USE_PARMETIS
312
libscalesppm_la_SOURCES += ppm/ppm_graph_partition_mpi.f90 \
313
	ppm/parmetis_wrap.c
312
libscalesppm_la_SOURCES += ppm/ppm_graph_partition_mpi.f90
313
if HAVE_PARMETIS_V3
314
AM_FCFLAGS += $(FPP_DEFOPT)HAVE_PARMETIS_V3
315
libscalesppm_la_SOURCES += ppm/parmetis_wrap.c
316
endif
314 317
endif
315 318
if USE_METIS
316 319
AM_FCFLAGS += $(FPP_DEFOPT)USE_METIS
320
if HAVE_METIS_V4
321
AM_FCFLAGS += $(FPP_DEFOPT)HAVE_METIS_V4
322
endif
317 323
libscalesppm_la_SOURCES += ppm/ppm_graph_partition_serial.f90
318 324
endif
319 325
if USE_FC_NETCDF
ppm-1.0.4/src/ppm/ppm_graph_partition_mpi.f90 2017-09-25 01:16:55.319543232 -0400
39 39
!> This is currently only a convenient wrapper of ParMeTis, other
40 40
!! heuristics are to follow later.
41 41
MODULE ppm_graph_partition_mpi
42
  USE iso_c_binding, ONLY: c_int, c_float
42
#ifdef HAVE_PARMETIS_V3
43
  USE iso_c_binding, ONLY: c_int
44
#endif
45
  USE iso_c_binding, ONLY: c_ptr, c_null_ptr, c_loc
43 46
  USE ppm_base, ONLY: abort_ppm
44 47
#ifdef USE_MPI_MOD
45 48
  USE mpi
......
53 56
  INTERFACE
54 57
    SUBROUTINE parmetis_v3_partkway(vtxdist, xadj, adjncy, vwgt, adjwgt, &
55 58
         wgtflag, numflag, ncon, nparts, tpwgts, ubvec, options, edgecut, &
56
         part, comm)
57
      USE iso_c_binding, ONLY: c_int, c_float
59
         part, comm) BIND(C)
60
#ifdef HAVE_PARMETIS_V3
61
      USE iso_c_binding, ONLY: c_int
62
#endif
63
      USE iso_c_binding, ONLY: c_ptr
58 64
      IMPORT :: ppm_idx
59
      INTEGER(ppm_idx), INTENT(in) :: vtxdist(*), xadj(*), adjncy(*), &
60
           vwgt(*), adjwgt(*)
65
      IMPORT :: ppm_real
66
      INTEGER(ppm_idx), INTENT(in) :: vtxdist(*), xadj(*), adjncy(*)
67
      TYPE(c_ptr), VALUE, INTENT(in) :: vwgt, adjwgt
68
#ifdef HAVE_PARMETIS_V3
61 69
      INTEGER(c_int), INTENT(in) :: wgtflag, numflag, ncon, nparts, options(*)
62
      REAL(c_float), INTENT(in) :: tpwgts(ncon, nparts), ubvec(ncon)
70
#else
71
      INTEGER(ppm_idx), INTENT(in) :: wgtflag, numflag, ncon, nparts, options(*)
72
#endif
73
      TYPE(c_ptr), VALUE, INTENT(in) :: tpwgts
74
      REAL(ppm_real), INTENT(in) :: ubvec(ncon)
75
#ifdef HAVE_PARMETIS_V3
63 76
      INTEGER(c_int), INTENT(out) :: edgecut
77
#else
78
      INTEGER(ppm_idx), INTENT(out) :: edgecut
79
#endif
64 80
      INTEGER(ppm_idx), INTENT(out) :: part(*)
65 81
      INTEGER, INTENT(in) :: comm
66 82
    END SUBROUTINE parmetis_v3_partkway
......
88 104
    INTEGER(ppm_idx), INTENT(in) :: edge_lists(:)
89 105
    INTEGER(ppm_idx), INTENT(out) :: partition_out(*)
90 106
    INTEGER, OPTIONAL, INTENT(in) :: comm
91
    INTEGER, OPTIONAL, INTENT(in) :: num_partitions
92
    REAL(c_float), OPTIONAL, INTENT(in) :: balance(:, :)
93
    INTEGER, OPTIONAL, INTENT(in) :: num_vertex_weights
94
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: vertex_weights(:)
95
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: edge_weights(:)
107
#ifdef HAVE_PARMETIS_V3
108
    INTEGER(c_int), OPTIONAL, INTENT(in) :: num_partitions
109
#else
110
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: num_partitions
111
#endif
112
    REAL(ppm_real), OPTIONAL, TARGET, INTENT(in) :: balance(:, :)
113
#ifdef HAVE_PARMETIS_V3
114
    INTEGER(c_int), OPTIONAL, INTENT(in) :: num_vertex_weights
115
#else
116
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: num_vertex_weights
117
#endif
118
    INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: vertex_weights(:)
119
    INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: edge_weights(:)
120
#ifdef HAVE_PARMETIS_V3
96 121
    INTEGER(c_int) :: wgtflag
122
#else
123
    INTEGER(ppm_idx) :: wgtflag
124
#endif
97 125
    INTEGER :: part_comm, comm_size, comm_rank, ierror, i, ierror_
98 126
    INTEGER, ALLOCATABLE :: vtxdist(:)
99
    INTEGER(c_int) :: metis_options(0:2), edge_cut, num_parts
127
#ifdef HAVE_PARMETIS_V3
128
    INTEGER(c_int) :: metis_options(0:2), edge_cut, ncon, num_parts
129
#else
130
    INTEGER(ppm_idx) :: metis_options(0:2), edge_cut, ncon, num_parts
131
#endif
100 132
    INTEGER :: msg_len
101 133
    CHARACTER(len=mpi_max_error_string) :: msg
102
    INTEGER(ppm_idx) :: dummy_weights(1)
103
    REAL(c_float) :: dummy_balance(1)
134
    TYPE(c_ptr) :: vwgt, adjwgt
135
    TYPE(c_ptr) :: tpwgts
136
#ifndef HAVE_PARMETIS_V3
137
    REAL(ppm_real), ALLOCATABLE, TARGET :: tpwgts_balance(:, :)
138
#endif
104 139

  
105 140
    IF (PRESENT(comm)) THEN; part_comm = comm; ELSE; part_comm = mpi_comm_world
106 141
    END IF
......
135 170
    wgtflag = 0
136 171
    IF (PRESENT(vertex_weights)) wgtflag = 2
137 172
    IF (PRESENT(edge_weights)) wgtflag = IOR(wgtflag, 1)
173
    IF (PRESENT(num_vertex_weights)) THEN
174
      ncon = num_vertex_weights
175
    ELSE
176
      ncon = 1
177
    END IF
138 178
    IF (PRESENT(num_partitions)) THEN
139 179
      num_parts = num_partitions
140 180
    ELSE
141 181
      num_parts = comm_size
142 182
    END IF
143 183
    metis_options(0) = 0
144
    IF (PRESENT(balance) .AND. PRESENT(edge_weights)) THEN
145
      CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
146
           vertex_weights, edge_weights, wgtflag, 1, num_vertex_weights, &
147
           num_parts, balance, (/ REAL(1.05, c_float) /), metis_options, &
148
           edge_cut, partition_out, part_comm)
149
    ELSE IF(PRESENT(balance)) THEN
150
      CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
151
           vertex_weights, dummy_weights, wgtflag, 1, num_vertex_weights, &
152
           num_parts, balance, (/ REAL(1.05, c_float) /), metis_options, &
153
           edge_cut, partition_out, part_comm)
154
    ELSE ! neighter balance nor edge_weights present
155
      CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
156
           vertex_weights, dummy_weights, wgtflag, 1, num_vertex_weights, &
157
           num_parts, dummy_balance, (/ REAL(1.05, c_float) /), metis_options, &
158
           edge_cut, partition_out, part_comm)
184
    IF (PRESENT(vertex_weights)) THEN
185
      vwgt = c_loc(vertex_weights(1))
186
    ELSE
187
      vwgt = c_null_ptr
188
    END IF
189
    IF (PRESENT(edge_weights)) THEN
190
      adjwgt = c_loc(edge_weights(1))
191
    ELSE
192
      adjwgt = c_null_ptr
193
    END IF
194
    IF (PRESENT(balance)) THEN
195
      tpwgts = c_loc(balance(1, 1))
196
    ELSE
197
#ifdef HAVE_PARMETIS_V3
198
      tpwgts = c_null_ptr
199
#else
200
      ALLOCATE(tpwgts_balance(ncon, num_parts))
201
      tpwgts_balance = 1 / num_parts
202
      tpwgts = c_loc(tpwgts_balance(1, 1))
203
#endif
159 204
    END IF
205
    CALL parmetis_v3_partkway(vtxdist, edge_list_lens, edge_lists, &
206
         vwgt, adjwgt, wgtflag, 1, ncon, num_parts, tpwgts, &
207
         (/ REAL(1.05, ppm_real) /), metis_options, edge_cut, &
208
         partition_out, part_comm)
160 209
  END SUBROUTINE graph_partition_parmetis
161 210
END MODULE ppm_graph_partition_mpi
162 211
!
ppm-1.0.4/src/ppm/ppm_graph_partition_serial.f90 2017-09-24 03:12:12.523645746 -0400
37 37
!
38 38
!> perform partitioning of graph from serial code
39 39
MODULE ppm_graph_partition_serial
40
  USE iso_c_binding, ONLY: c_int, c_float
40
#ifdef HAVE_METIS_V4
41
  USE iso_c_binding, ONLY: c_int
42
#endif
43
  USE iso_c_binding, ONLY: c_ptr, c_null_ptr, c_loc
41 44
  USE ppm_base, ONLY: assertion
42 45
  USE ppm_extents, ONLY: extent
43 46
  USE ppm_graph_csr, ONLY: graph_csr, num_nodes
......
46 49
  IMPLICIT NONE
47 50
  PRIVATE
48 51
#include <ppm.inc>
49
  EXTERNAL :: METIS_mCPartGraphKway
50
  EXTERNAL :: METIS_PartGraphKway
52
#ifdef HAVE_METIS_V4
53
  INTERFACE
54
    SUBROUTINE metis_mcpartgraphkway(nvtxs, ncon, xadj, adjncy, vwgt, adjwgt, &
55
         wgtflag, numflag, nparts, rubvec, options, edgecut, part) BIND(C)
56
      USE iso_c_binding, ONLY: c_int, c_ptr
57
      IMPORT :: ppm_idx
58
      IMPORT :: ppm_real
59
      INTEGER(ppm_idx), INTENT(in) :: xadj(*), adjncy(*)
60
      TYPE(c_ptr), VALUE, INTENT(in) :: vwgt, adjwgt
61
      INTEGER(c_int), INTENT(in) :: nvtxs, wgtflag, numflag, ncon, nparts, options(*)
62
      REAL(ppm_real), INTENT(in) :: rubvec(ncon)
63
      INTEGER(c_int), INTENT(out) :: edgecut
64
      INTEGER(ppm_idx), INTENT(out) :: part(*)
65
    END SUBROUTINE metis_mcpartgraphkway
66
  END INTERFACE
67
#else
68
  INTERFACE
69
    SUBROUTINE metis_setdefaultoptions(options) BIND(C)
70
      IMPORT :: ppm_idx
71
      INTEGER(ppm_idx), INTENT(out) :: options(*)
72
    END SUBROUTINE metis_setdefaultoptions
73
  END INTERFACE
74
#endif
75
  INTERFACE
76
#ifdef HAVE_METIS_V4
77
    SUBROUTINE metis_partgraphkway(nvtxs, xadj, adjncy, vwgt, adjwgt, &
78
         wgtflag, numflag, nparts, options, edgecut, part) BIND(C)
79
      USE iso_c_binding, ONLY: c_int
80
#else
81
    SUBROUTINE metis_partgraphkway(nvtxs, ncon, xadj, adjncy, vwgt, vsize, &
82
         adjwgt, nparts, tpwgts, ubvec, options, edgecut, part) BIND(C)
83
#endif
84
      USE iso_c_binding, ONLY: c_ptr
85
      IMPORT :: ppm_idx
86
      INTEGER(ppm_idx), INTENT(in) :: xadj(*), adjncy(*)
87
      TYPE(c_ptr), VALUE, INTENT(in) :: vwgt, adjwgt
88
#ifdef HAVE_METIS_V4
89
      INTEGER(c_int), INTENT(in) :: nvtxs, wgtflag, numflag, nparts, options(*)
90
#else
91
      INTEGER(ppm_idx), INTENT(in) :: nvtxs, ncon, nparts, options(*)
92
      TYPE(c_ptr), VALUE, INTENT(in) :: vsize
93
      TYPE(c_ptr), VALUE, INTENT(in) :: tpwgts, ubvec
94
#endif
95
#ifdef HAVE_METIS_V4
96
      INTEGER(c_int), INTENT(out) :: edgecut
97
#else
98
      INTEGER(ppm_idx), INTENT(out) :: edgecut
99
#endif
100
      INTEGER(ppm_idx), INTENT(out) :: part(*)
101
    END SUBROUTINE metis_partgraphkway
102
  END INTERFACE
51 103
  PUBLIC :: graph_partition_metis
52 104
  INTERFACE graph_partition_metis
53 105
    MODULE PROCEDURE graph_partition_metis_base
......
58 110
  SUBROUTINE graph_partition_metis_base(num_vertices, edge_list_lens, &
59 111
       edge_lists, partition_out, num_partitions, &
60 112
       imbalance_tolerance, vertex_weights, edge_weights)
113
#ifdef HAVE_METIS_V4
114
    INTEGER(c_int), INTENT(in) :: num_vertices
115
#else
61 116
    INTEGER(ppm_idx), INTENT(in) :: num_vertices
117
#endif
62 118
    INTEGER(ppm_idx), INTENT(in) :: edge_list_lens(:)
63 119
    INTEGER(ppm_idx), INTENT(in) :: edge_lists(:)
64 120
    INTEGER(ppm_idx), INTENT(out) :: partition_out(:)
65
    INTEGER, INTENT(in) :: num_partitions
66
    REAL(c_float), OPTIONAL, INTENT(in) :: imbalance_tolerance(:)
67
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: vertex_weights(*)
68
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: edge_weights(*)
69
    INTEGER(ppm_idx) :: vw_dummy(1), ew_dummy(1)
121
#ifdef HAVE_METIS_V4
122
    INTEGER(c_int), INTENT(in) :: num_partitions
123
#else
124
    INTEGER(ppm_idx), INTENT(in) :: num_partitions
125
#endif
126
    REAL(ppm_real), OPTIONAL, TARGET, INTENT(in) :: imbalance_tolerance(:)
127
    INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: vertex_weights(*)
128
    INTEGER(ppm_idx), OPTIONAL, TARGET, INTENT(in) :: edge_weights(*)
129
    TYPE(c_ptr) :: vwgt, adjwgt
130
#ifdef HAVE_METIS_V4
70 131
    INTEGER(c_int) :: wgtflag
71 132
    INTEGER(c_int) :: metis_options(0:4), edge_cut
72 133

  
73 134
    metis_options(0) = 0
74 135
    metis_options(1:4) = 0
136
#else
137
    TYPE(c_ptr) :: vsize = c_null_ptr
138
    TYPE(c_ptr) :: tpwgts = c_null_ptr, ubvec
139
    INTEGER(ppm_idx) :: metis_options(0:39), edge_cut
140

  
141
    CALL metis_setdefaultoptions(metis_options)
142
    ! METIS_OPTION_NUMBERING : use Fortran-style
143
    metis_options(17) = 1
144
#endif
145

  
146
    IF (PRESENT(vertex_weights)) THEN
147
      vwgt = c_loc(vertex_weights(1))
148
    ELSE
149
      vwgt = c_null_ptr
150
    END IF
151
    IF (PRESENT(edge_weights)) THEN
152
      adjwgt = c_loc(edge_weights(1))
153
    ELSE
154
      adjwgt = c_null_ptr
155
    END IF
75 156
    IF (PRESENT(imbalance_tolerance)) THEN
76 157
      CALL assertion(PRESENT(vertex_weights), line=__LINE__, &
77 158
           source=__FILE__, &
78 159
           msg="when imbalance_tolerance is provided, vertex weights&
79 160
           & are also required")
161
#ifdef HAVE_METIS_V4
80 162
      wgtflag = MERGE(1, 0, PRESENT(edge_weights))
81
      IF (PRESENT(edge_weights)) THEN
82
        CALL metis_mCPartGraphKway(INT(num_vertices, c_int), &
83
             INT(SIZE(imbalance_tolerance), c_int), &
84
             edge_list_lens, edge_lists, &
85
             vertex_weights, edge_weights, wgtflag, 1_c_int, &
86
             INT(num_partitions, c_int), &
87
             imbalance_tolerance, metis_options, edge_cut, partition_out)
88
      ELSE
89
        CALL metis_mCPartGraphKway(INT(num_vertices, c_int), &
90
             INT(SIZE(imbalance_tolerance), c_int), &
91
             edge_list_lens, edge_lists, &
92
             vertex_weights, ew_dummy, wgtflag, 1_c_int, &
93
             INT(num_partitions, c_int), &
94
             imbalance_tolerance, metis_options, edge_cut, partition_out)
95
      END IF
163
      CALL metis_mcpartgraphkway(num_vertices, &
164
           INT(SIZE(imbalance_tolerance), c_int), edge_list_lens, edge_lists, &
165
           vwgt, adjwgt, wgtflag, 1, num_partitions, imbalance_tolerance, &
166
           metis_options, edge_cut, partition_out)
167
#else
168
      ubvec = c_loc(imbalance_tolerance(1))
169
#endif
96 170
    ELSE
171
#ifdef HAVE_METIS_V4
97 172
      wgtflag = MERGE(2, 0, PRESENT(vertex_weights))
98 173
      wgtflag = IOR(wgtflag, MERGE(1, 0, PRESENT(edge_weights)))
99
      SELECT CASE(wgtflag)
100
      CASE(0)
101
        CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
102
             edge_list_lens, edge_lists, &
103
             vw_dummy, ew_dummy, wgtflag, INT(1, c_int), &
104
             INT(num_partitions, c_int), &
105
             metis_options, edge_cut, partition_out)
106
      CASE(1)
107
        CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
108
             edge_list_lens, edge_lists, &
109
             vw_dummy, edge_weights, wgtflag, INT(1, c_int), &
110
             INT(num_partitions, c_int), &
111
             metis_options, edge_cut, partition_out)
112
      CASE(2)
113
        CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
114
             edge_list_lens, edge_lists, &
115
             vertex_weights, ew_dummy, wgtflag, INT(1, c_int), &
116
             INT(num_partitions, c_int), &
117
             metis_options, edge_cut, partition_out)
118
      CASE(3)
119
        CALL MeTiS_PartGraphKway(INT(num_vertices, c_int), &
120
             edge_list_lens, edge_lists, &
121
             vertex_weights, edge_weights, wgtflag, INT(1, c_int), &
122
             INT(num_partitions, c_int), &
123
             metis_options, edge_cut, partition_out)
124
      END SELECT
174
      CALL metis_partgraphkway(num_vertices, edge_list_lens, edge_lists, vwgt, &
175
           adjwgt, wgtflag, 1, num_partitions, metis_options, edge_cut, &
176
           partition_out)
177
#else
178
      ubvec = c_null_ptr
179
#endif
125 180
    END IF
181
#ifndef HAVE_METIS_V4
182
    CALL metis_partgraphkway(num_vertices, 1, edge_list_lens, &
183
         edge_lists, vwgt, vsize, adjwgt, num_partitions, tpwgts, ubvec, &
184
         metis_options, edge_cut, partition_out)
185
#endif
126 186
  END SUBROUTINE graph_partition_metis_base
127 187

  
128 188
  SUBROUTINE graph_partition_metis_csr(partition, graph, num_partitions, &
......
175 235
    TYPE(partition_assignment), INTENT(out) :: partition
176 236
    TYPE(graph_csr), INTENT(in) :: graph
177 237
    INTEGER, INTENT(in) :: num_partitions
178
    REAL(c_float), INTENT(in) :: imbalance_tolerance(:)
238
    REAL(ppm_real), INTENT(in) :: imbalance_tolerance(:)
179 239
    INTEGER(ppm_idx), INTENT(in) :: vertex_weights(:,:)
180 240
    INTEGER(ppm_idx), OPTIONAL, INTENT(in) :: edge_weights(:)
181 241