metis.F90

Go to the documentation of this file.

!! Copyright (C) 2013 M. Oliveira
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
! -----------------------------------------------------------------------
! -----------------------------------------------------------------------
 
module metis_oct_m
  use, intrinsic :: iso_fortran_env
  use mpi_oct_m
  implicit none
 
  public
 
  ! Options codes (copied from metis.h)
  integer, parameter ::          &
    METIS_OPTION_PTYPE     = 1,  &
    metis_option_objtype   = 2,  &
    metis_option_ctype     = 3,  &
    metis_option_iptype    = 4,  &
    metis_option_rtype     = 5,  &
    metis_option_dbglvl    = 6,  &
    metis_option_niter     = 7,  &
    metis_option_ncuts     = 8,  &
    metis_option_seed      = 9,  &
    metis_option_no2hop    = 10, &
    metis_option_minconn   = 11, &
    metis_option_contig    = 12, &
    metis_option_compress  = 13, &
    metis_option_ccorder   = 14, &
    metis_option_pfactor   = 15, &
    metis_option_nseps     = 16, &
    metis_option_ufactor   = 17, &
    metis_option_numbering = 18, &
    metis_option_help      = 19, &
    metis_option_tpwgts    = 20, &
    metis_option_ncommon   = 21, &
    metis_option_nooutput  = 22, &
    metis_option_balance   = 23, &
    metis_option_gtype     = 24, &
    metis_option_ubvec     = 25
 
  !Error code from metis.h
  integer, parameter ::         &
    METIS_OK              = 1,  & !< Returned normally
    metis_error_input     = -2, & 
    metis_error_memory    = -3, & 
    metis_error           = -4    
 
  ! define the integer kind as needed for the metis installation
#if METIS_IDXTYPEWIDTH == 64
  integer, parameter :: imetis = int64
  type(MPI_Datatype), parameter :: MPI_METIS_INT = mpi_integer8
#else
  integer, parameter :: imetis = int32
  type(MPI_Datatype), parameter :: MPI_METIS_INT = mpi_integer
#endif
 
  interface
 
#if defined(HAVE_PARMETIS) || defined(HAVE_METIS)
    subroutine oct_metis_setdefaultoptions(options)
      import :: imetis
      implicit none
      integer(imetis), intent(inout) :: options
    end subroutine oct_metis_setdefaultoptions
 
    integer function oct_metis_partgraphrecursive(nvtxs, ncon, xadj, adjncy, nparts, tpwgts, ubvec, options, objval, part)
      use, intrinsic :: iso_fortran_env
      import :: imetis
      implicit none
      integer(imetis), intent(in)  :: nvtxs
      integer(imetis), intent(in)  :: ncon
      integer(imetis), intent(in)  :: xadj
      integer(imetis), intent(in)  :: adjncy
      integer(imetis), intent(in)  :: nparts
      real(real32),        intent(in)  :: tpwgts
      real(real32),        intent(in)  :: ubvec
      integer(imetis), intent(in)  :: options
      integer(imetis), intent(out) :: objval
      integer(imetis), intent(out) :: part
    end function oct_metis_partgraphrecursive
 
    integer function oct_metis_partgraphkway(nvtxs, ncon, xadj, adjncy, nparts, tpwgts, ubvec, options, objval, part)
      use, intrinsic :: iso_fortran_env
      import :: imetis
      implicit none
      integer(imetis), intent(in)  :: nvtxs
      integer(imetis), intent(in)  :: ncon
      integer(imetis), intent(in)  :: xadj
      integer(imetis), intent(in)  :: adjncy
      integer(imetis), intent(in)  :: nparts
      real(real32),        intent(in)  :: tpwgts
      real(real32),        intent(in)  :: ubvec
      integer(imetis), intent(in)  :: options
      integer(imetis), intent(out) :: objval
      integer(imetis), intent(out) :: part
    end function oct_metis_partgraphkway
 
#endif
#if defined(HAVE_PARMETIS)
 
    subroutine oct_parmetis_v3_partkway(vtxdist, xadj, adjncy, ncon, nparts, tpwgts, ubvec, options, edgecut, part, comm)
      use, intrinsic :: iso_fortran_env
      import :: imetis
      implicit none
      integer(imetis), intent(in)  :: vtxdist
      integer(imetis), intent(in)  :: xadj
      integer(imetis), intent(in)  :: adjncy
      integer(imetis), intent(in)  :: ncon
      integer(imetis), intent(in)  :: nparts
      real(real32),        intent(in)  :: tpwgts
      real(real32),        intent(in)  :: ubvec
      integer(imetis), intent(in)  :: options
      integer(imetis), intent(out) :: edgecut
      integer(imetis), intent(out) :: part
      integer,         intent(in)  :: comm
    end subroutine oct_parmetis_v3_partkway
 
#endif
  end interface
 
  interface i4_to_imetis
    module procedure i4_to_imetis_0, i4_to_imetis_1
  end interface i4_to_imetis
 
  interface imetis_to_i4
    module procedure imetis_to_i4_0, imetis_to_i4_1
  end interface imetis_to_i4
 
  interface i8_to_imetis
    module procedure i8_to_imetis_0, i8_to_imetis_1
  end interface i8_to_imetis
 
  interface imetis_to_i8
    module procedure imetis_to_i8_0, imetis_to_i8_1
  end interface imetis_to_i8
 
contains
 
  integer(imetis) pure function i4_to_imetis_0(ii)
    integer(int32), intent(in) :: ii
 
    i4_to_imetis_0 = int(ii, imetis)
  end function i4_to_imetis_0
 
  integer(int32) pure function imetis_to_i4_0(ii)
    integer(imetis), intent(in) :: ii
 
    imetis_to_i4_0 = int(ii, int32)
  end function imetis_to_i4_0
 
  pure function i4_to_imetis_1(ii)
    integer(int32), intent(in) :: ii(:)
    integer(imetis) :: i4_to_imetis_1(lbound(ii, 1):ubound(ii, 1))
 
    i4_to_imetis_1 = int(ii, imetis)
  end function i4_to_imetis_1
 
  pure function imetis_to_i4_1(ii)
    integer(imetis), intent(in) :: ii(:)
    integer(int32) :: imetis_to_i4_1(lbound(ii, 1, kind=imetis):ubound(ii, 1, kind=imetis))
 
    imetis_to_i4_1 = int(ii, int32)
  end function imetis_to_i4_1
 
  integer(imetis) pure function i8_to_imetis_0(ii)
    integer(int64), intent(in) :: ii
 
    i8_to_imetis_0 = int(ii, imetis)
  end function i8_to_imetis_0
 
  integer(int64) pure function imetis_to_i8_0(ii)
    integer(imetis), intent(in) :: ii
 
    imetis_to_i8_0 = int(ii, int64)
  end function imetis_to_i8_0
 
  pure function i8_to_imetis_1(ii)
    integer(int64), intent(in) :: ii(:)
    integer(imetis) :: i8_to_imetis_1(lbound(ii, 1, kind=int64):ubound(ii, 1, kind=int64))
 
    i8_to_imetis_1 = int(ii, imetis)
  end function i8_to_imetis_1
 
  pure function imetis_to_i8_1(ii)
    integer(imetis), intent(in) :: ii(:)
    integer(int64) :: imetis_to_i8_1(lbound(ii, 1, kind=imetis):ubound(ii, 1, kind=imetis))
 
    imetis_to_i8_1 = int(ii, int64)
  end function imetis_to_i8_1
end module metis_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: