Question

我正在尝试使用gfortran在GNU平台上编译一些专有的Fortran代码。有谁知道例程sortqq（Intel）或qsort_up（IBM）是否有开放源代码？

Answer 1

libc包含qsort（）。如果你在Fortran中为它编写了一个bind（c）接口，你可以调用它。

为了开始，这是一个示例模块，它提供了模仿专有功能的my_qsort包装器：

$ cat sort.f90
module m
  use, intrinsic :: iso_c_binding
  implicit none
  private

  interface
    subroutine qsort(base, nel, width, compar) bind(c, name='qsort')
      import c_size_t, c_int
      implicit none
      type(*), intent(inout) :: base(*)
      integer(c_size_t), value :: nel
      integer(c_size_t), value :: width
      abstract interface
        function compar_iface(a, b) bind(c)
          import c_int, c_ptr
          implicit none
          integer(c_int) compar_iface
          type(c_ptr), value :: a, b
        end function
      end interface
      procedure(compar_iface) compar
    end subroutine
  end interface

  interface my_qsort
    module procedure my_qsort_int4
    module procedure my_qsort_int8
    module procedure my_qsort_real4
    module procedure my_qsort_real8
  end interface
  public my_qsort
contains
  subroutine my_qsort_int4(a, nel)
    integer(c_int), intent(inout) :: a(*)
    integer(4), value :: nel
    call qsort(a, int(nel, c_size_t), c_sizeof(a(1)), less_int4)
  end subroutine

  subroutine my_qsort_int8(a, nel)
    integer(c_long_long), intent(inout) :: a(*)
    integer(4), value :: nel
    call qsort(a, int(nel, c_size_t), c_sizeof(a(1)), less_int8)
  end subroutine

  subroutine my_qsort_real4(a, nel)
    real(c_float), intent(inout) :: a(*)
    integer(4), value :: nel
    call qsort(a, int(nel, c_size_t), c_sizeof(a(1)), less_real4)
  end subroutine

  subroutine my_qsort_real8(a, nel)
    real(c_double), intent(inout) :: a(*)
    integer(4), value :: nel
    call qsort(a, int(nel, c_size_t), c_sizeof(a(1)), less_real8)
  end subroutine

  function less_int4(a, b) result(result)
    integer(c_int) result
    type(c_ptr), value :: a, b
    integer(c_int), pointer :: ap, bp
    call c_f_pointer(a, ap)
    call c_f_pointer(b, bp)
    result = int(ap - bp, c_int)
  end function

  function less_int8(a, b) result(result)
    integer(c_int) result
    type(c_ptr), value :: a, b
    integer(c_long_long), pointer :: ap, bp
    call c_f_pointer(a, ap)
    call c_f_pointer(b, bp)
    result = int(ap - bp, c_int)
  end function

  function less_real4(a, b) result(result)
    integer(c_int) result
    type(c_ptr), value :: a, b
    real(c_float), pointer :: ap, bp
    call c_f_pointer(a, ap)
    call c_f_pointer(b, bp)
    result = int(ap - bp, c_int)
  end function

  function less_real8(a, b) result(result)
    integer(c_int) result
    type(c_ptr), value :: a, b
    real(c_double), pointer :: ap, bp
    call c_f_pointer(a, ap)
    call c_f_pointer(b, bp)
    result = int(ap - bp, c_int)
  end function
end module

program main
  use m
  implicit none
  integer(4) a(10)
  real(4) b(4)

  a = [ 2, 6 , 1, 3, 10, 9, 7, 8, 4, 5 ]
  call my_qsort(a, 10)
  print *, a

  b = [ 2.0, 5.0, 1.0, -5.0 ]
  call my_qsort(b, 4)
  print *, b
end program

$ gfortran sort.f90
$ ./a.out
           1           2           3           4           5           6           7           8           9          10
  -5.00000000       1.00000000       2.00000000       5.00000000
$

英特尔Fortran排序例程的开源版本

1 个答案: