简单的Fortran回调函数例子

首先声明一下,其实我并不是很懂回调函数是什么。根据我看过几篇文章后留下的印象就是为某个过程/函数提供一个自行编写的过程/函数作为参数。

因为我也不是很懂,所以这篇文章只是提供两个例子供参考。更复杂的玩法或许需要更了解C语言以及Fortran与C语言混编的方法(即iso_c_binding模块)。目前网络上关于Fortran回调函数的较为详细的讨论我只看到这个:Type Casting in Callbacks,里面的例子感觉很trivial。

第一个例子来自于Fortran与C语言,回调函数的使用比较,看我的代码之前建议先看这篇文章了解背景。简单来说,是需要用Fortran实现这样一个过程,其接收一个过程作为参数在内部执行,并接收该作为参数的过程所需要的参数。

module m
! https://blog.csdn.net/hjh2005/article/details/7448004
  use iso_c_binding, only: c_ptr, c_f_pointer
  implicit none
  
  interface
    subroutine printNumber(data)
      import c_ptr
      type(c_ptr), intent(in) :: data
    end subroutine
  end interface
  
  contains

  subroutine SubroutineRunTenTimes(sub, data)
    procedure(printNumber) :: sub
    type(c_ptr), intent(in) :: data
    integer :: i

    do i = 1, 10
      call sub(data)
    end do

  end subroutine

  subroutine printInteger(num)
    type(c_ptr), intent(in) :: num
    integer, pointer :: int_ptr

    call c_f_pointer(num, int_ptr)
    write(*,*) int_ptr

  end subroutine

  subroutine printReal(num)
    type(c_ptr), intent(in) :: num
    real, pointer :: real_ptr

    call c_f_pointer(num, real_ptr)
    write(*,*) real_ptr

  end subroutine

end module

program main
  use m
  use iso_c_binding, only: c_loc
  integer, pointer :: i => null()
  real, pointer :: r => null()
  integer :: istat

  allocate(i, source=1, stat=istat)
  allocate(r, source=1., stat=istat)

  call SubroutineRunTenTimes(printInteger, c_loc(i))
  call SubroutineRunTenTimes(printReal, c_loc(r))

end program

在那篇文章中,使用了transfer函数。但是按照Type Casting in Callbacks中所述,这一方法应当被废弃。因此我按照该文的提示,使用c_ptr类型传递数据。


(为了方便讨论,借助这张图描述)

首先要明确一点,Fortran在传递过程callback作为参数时,作为参数的过程callback必须要有显式的接口(无论是用interface还是module)。这时候不要指望利用重载,重载的名字不能作为实参。所以要显式地传入不同情况的过程callback,比如sub_intsub_real。而如果你写一个重载的接口sub,则肯定是没有用的。

此外,传入的过程callback本身所接收的参数params类型是确定的,这使得过程host的第二个参数params很难处理,因为我们可能会传入一个整数或实数。我提供的两个例子主要就是针对第二点提供解决方案。

为了能够传入各种类型的params,第一种尝试是利用c_ptr类型,这样无论何种类型的数据都能保证callback(们)具有相同的接口。因为Fortran自身的指针依然有类型的限制,所以通常的指针无法做到指向任意类型的数据。class(*), pointer的多态指针看起来也能做到,但我实际写了一下发现写不出来,也不再继续讨论。用c_ptr类型,使得我们可以传递各种类型的参数,然后在callback过程内部再将其重新与相应类型的指针绑定在一起。

第二种方式则是在host过程的层面利用重载实现,看以下排序库的例子。

module SortLib
  implicit none

  contains
  subroutine BubbleSort_int(array)
    integer, dimension(:), intent(inout) :: array
    integer :: tmp
    integer :: i, j

    do i = 1, size(array)-1
      do j = 1, size(array)-i
        if(array(j) > array(j+1)) then
          tmp = array(j)
          array(j) = array(j+1)
          array(j+1) = tmp
        end if
      end do
    end do

  end subroutine

  subroutine BubbleSort_real(array)
    real, dimension(:), intent(inout) :: array
    real :: tmp
    integer :: i, j

    do i = 1, size(array)-1
      do j = 1, size(array)-i
        if(array(j) > array(j+1)) then
          tmp = array(j)
          array(j) = array(j+1)
          array(j+1) = tmp
        end if
      end do
    end do

  end subroutine

  subroutine SelectionSort_int(array)
    integer, dimension(:), intent(inout) :: array
    integer :: tmp
    integer :: i, minIndex
 
    do i = 1, size(array)-1
      minIndex = minloc(array(i:), 1) + i - 1
      if (array(i) > array(minIndex)) then
        tmp = array(i)
        array(i) = array(minIndex)
        array(minIndex) = tmp
      end if
    end do

  end subroutine

  subroutine SelectionSort_real(array)
    real, dimension(:), intent(inout) :: array
    real :: tmp
    integer :: i, minIndex
 
    do i = 1, size(array)-1
      minIndex = minloc(array(i:), 1) + i - 1
      if (array(i) > array(minIndex)) then
        tmp = array(i)
        array(i) = array(minIndex)
        array(minIndex) = tmp
      end if
    end do

  end subroutine
 
end module

module m
  implicit none

  interface dealWithArray
    module procedure dealWithArray_real
    module procedure dealWithArray_int
  end interface

  interface
    subroutine Sort_int(array)
      integer, dimension(:), intent(inout) :: array
    end subroutine
    subroutine Sort_real(array)
      real, dimension(:), intent(inout) :: array
    end subroutine
  end interface

  contains

  subroutine dealWithArray_real(sort_sub, array)
    procedure(Sort_real) :: sort_sub
    real, dimension(:), intent(inout) :: array

    call sort_sub(array)
    write(*,"('Min element: ',F4.1,', Max element: ',F4.1)") array(1), array(size(array))

  end subroutine
  
  subroutine dealWithArray_int(sort_sub, array)
    procedure(Sort_int) :: sort_sub
    integer, dimension(:), intent(inout) :: array

    call sort_sub(array)
    write(*,"('Min element: ',I3,', Max element: ',I3)") array(1), array(size(array))

  end subroutine

end module

program main
  use SortLib
  use m
  implicit none
  integer, dimension(8) :: a = [1,3,6,4,7,3,2,7]
  integer, dimension(8) :: b = [8,5,8,2,1,9,3,5]
  real, dimension(8) :: c = [1,3,6,4,7,3,2,7]
  real, dimension(8) :: d = [8,5,8,2,1,9,3,5]
  
  call dealWithArray(BubbleSort_int, a)
  ! Min element:   1, Max element:   7
  call dealWithArray(BubbleSort_real, c)
  ! Min element:  1.0, Max element:  7.0
  call dealWithArray(SelectionSort_int, b)
  ! Min element:   1, Max element:   9
  call dealWithArray(SelectionSort_real, d)
  ! Min element:  1.0, Max element:  9.0
end program

这个例子的关键之处不在于SortLib中的各种排序方法的实现,实际上其中的子程序就是回调函数中由用户编写,传递给外部库dealWithArray的过程。

这个解决方法通过重载dealWithArray,使得无论是对整数排序还是对实数排序都能正确处理。至于由用户提供的排序方法,分为整数和实数(也可以进一步拓展,包含更多类型)的两种,在重载时会跟随着具体的过程。我觉得还是比较容易理解的,所以不多谈。

发表评论

电子邮件地址不会被公开。 必填项已用*标注