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

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 
$