Fortran笔记之过程重载，多态，泛型编程

参考自Introduction to Modern Fortran for the Earth System Sciences

过程重载

OOP中的另一个重要技术是过程重载(Procedure Overloading)（也称为“ad-hoc多态性(ad-hoc polymorphism)”）。这里的想法是，可以通过相同的名称访问多个过程，编译器根据虚参的类型（也称为“签名(signature)”）来确定调用哪个过程。显然，要使这一点起作用，这两个程序实际上必须有不同的签名。过程重载与泛型编程(generic programming)不同：

• 在泛型编程中，程序员编写了一个唯一的过程定义，编译器在必要时从该模板生成实际的、可调用的过程（参见第3.4节）；
• 在重载中，程序员将显式地为特定签名创建不同的函数。

为了将过程与重载的相同名称相关联，我们需要定义一个泛型接口(generic interface)：定义一个自定义的派生类型构造函数。这些是命名的接口块，块的名称将产生访问重载的名称。

定义泛型接口的两种情形：

• 在泛型接口内部，通过复制过程的定义部分来指定外部过程(external procedures)的接口。
• 对于在同一模块中定义的过程，我们需要使用module procedure<nameOfModuleProcedure>来指定。

下面的示例说明了这两种情况：

该示例将外部子例程swapReal和模块过程swapInteger分组，以便通过通用名称swap调用它们

5  ! 在module之外的过程
6  subroutine swapReal( a, b )
7    real, intent(inout) :: a, b
8    real :: tmp
9    tmp = a; a = b; b = tmp
10 end subroutine swapReal
11 
12 module Utilities
13   implicit none
14   private     ! 默认设置为私有
15   public swap ! 但是，需要将泛型接口公开
16   ! 泛型接口Generic interface
17   interface swap
18      ! 对于不在本模块的过程，需要显式接口
19      subroutine swapReal( a, b )
20        real, intent(inout) :: a, b
21      end subroutine swapReal
22      !
23      ! 但是，对于模块里的过程，则是通过加上'module procedure'声明
24      module procedure swapInteger
25   end interface swap
26 contains
27   ! Module-procedure.
28   subroutine swapInteger( a, b )
29     integer, intent(inout) :: a, b
30     integer :: tmp
31     tmp = a; a = b; b = tmp
32   end subroutine swapInteger
33 end module Utilities

Listing 3.37 src/Chapter3/overload_normal_procedures.f90 (excerpt)

通过module Utilities，可以相同的语句，交换integers和reals：

35 program test_util_a
36   use Utilities
37   implicit none
38   integer :: i1 = 1, i2 = 3
39   real    :: r1 = 9.2, r2 = 5.6
40
41   write(*,'("Initial state:",1x,2(a,i0,1x), 2(a,f0.2,1x))') &
42        "i1 = ", i1, ", i2 = ", i2, ", r1 = ", r1, ", r2 = ", r2
43   call swap( i1, i2 )
44   call swap( r1, r2 )
45   write(*,'("State after swaps:",1x,2(a,i0,1x), 2(a,f0.2,1x))') &
46        "i1 = ", i1, ", i2 = ", i2, ", r1 = ", r1, ", r2 = ", r2
47 end program test_util_a

Listing 3.38 src/Chapter3/overload_normal_procedures.f90 (excerpt)

请注意，我们仍然可以通过泛型接口（它是public）访问swapReal（即使它是private）。

重载需要有不同的签名（不同类型的虚参），且签名应该都是function或都是subroutine。

最后，还值得注意的是，还有一种额外的类型重载机制，使用了所谓的“泛型类型绑定过程(generic type-bound procedures)”。这是非常有益的，尤其是当模块所在的位置存在唯一的修改器时（仅导入选定的实体）。一个很容易发生的错误是忘记include泛型接口，这可能会导致调用隐式函数（例如赋值运算符），而不是模块中预期的重载。此处不谈这个问题（如果您遇到这种情况，请参阅Metcalf等人[Metcalf, M., Reid, J., Cohen, M.: Modern Fortran Explained. Oxford University Press, Oxford(2011)]）。

运算符重载 值得注意的是，运算符（如一元 .not. 或二元 +）同样也是过程，只有在语言的特殊支持下，才允许使用更方便的表示法（中缀表示法(infix notation)）——因此重载的概念也应该适用于它们。事实上，Fortran（和其他语言）允许开发人员为非内置类型重载这些函数。我们可以用 <operator(<operatorName>)替换泛型接口的名称（“在我们前面的示例中为swap”），其中operatorName是一个内置操作符，从而简单地实现这一点。如下所示：

 8 module Vec3d_class
 9   implicit none
10
11   type, public :: Vec3d
12      real :: mU = 0., mV = 0., mW = 0. ! Make 'private' in practice!
13    contains
14      procedure :: display ! Convenience output-method.
15   end type Vec3d
16
17   ! 用于运算符重载的泛型接口
18   interface operator(-)
19      module procedure negate   ! 一元负号
20      module procedure subtract ! 二元减号
21   end interface operator(-)
22
23 contains
24   type(Vec3d) function negate( inVec )
25     class(Vec3d), intent(in) :: inVec
26     negate%mU = -inVec%mU
27     negate%mV = -inVec%mV
28     negate%mW = -inVec%mW
29   end function negate
30
31   ! 注意：也可以用异构数据类型重载二进制运算符。
32   ! 在我们的例子中，我们可以为二元的“-”再设置两个重载，
33   ! 以便在inVec1或inVec2是标量时支持减法。
34   ! 在这种情况下，只需更改inVec1或inVec2的类型，并调整函数中的代码。
35   !
36   type(Vec3d) function subtract( inVec1, inVec2 )
37     class(Vec3d), intent(in) :: inVec1, inVec2
38     subtract%mU = inVec1%mU - inVec2%mU
39     subtract%mV = inVec1%mV - inVec2%mV
40     subtract%mW = inVec1%mW - inVec2%mW
41   end function subtract
42
43   ! 工具方法，用于更方便的展示'Vec3d'元素
44   ! 注：一个更好的解决方式是使用派生类型的I/O（参见Metcalf2011）
45   subroutine display( this, nameString )
46     class(Vec3d), intent(in) :: this
47     character(len=*), intent(in) :: nameString
48     write(*,'(2a,3(f0.2,2x),a)') &
49          trim(nameString), " = ( ", this%mU, this%mV, this%mW, ")"
50   end subroutine display
51 end module Vec3d_class

Listing 3.39 src/Chapter3/overload_intrinsic_operators.f90 (excerpt)

新的运算符可以被我们的派生类型数据中使用，如下：

53 program test_overload_intrinsic_operators
54   use Vec3d_class
55   implicit none
56   type(Vec3d) :: A = Vec3d(2., 4., 6.), B = Vec3d(1., 2., 3.)
57
58   write(*,'(/,a)') "initial-state:"
59   call A%display("A"); call B%display("B")
60
61   A = -A
62   write(*,'(/,a)') 'after operation "A = -A":'
63   call A%display("A"); call B%display("B")
64
65   A = A - B
66   write(*,'(/,a)') 'after operations "A = A - B":'
67   call A%display("A"); call B%display("B")
68 end program test_overload_intrinsic_operators

Listing 3.39 src/Chapter3/overload_intrinsic_operators.f90 (excerpt)

重载运算符时要注意的一个约束是：function需要用作实际过程，对于一元运算符使用一个参数，对于二元运算符分别使用两个参数（在这两种情况下参数都需要有intent(in)属性）。

有趣的是，在Fortran中甚至可以实现新的（一元/二元）运算符，这些运算符不是语言标准指定的。语法与前一种情况类似，只是我们用新操作符（在泛型接口中）的名称替换了内在操作符的名称。例如，这里是一个新操作符 .cross. 的接口块，用以计算两个Vec3d类型的向量的叉积：

18   ! Generic interface, for operator-overloading.
19   interface operator(.cross.)
20      module procedure cross_product ! binary
21   end interface operator(.cross.)

这是一个强大的技术，可以使得代码更加具有可读性，从而提升抽象化的水平，如下：

49   C = A .cross. B

与优先级相关的是，用户定义的一元运算符的优先级高于所有其他运算符，而用户定义的二元运算符的优先级则相反（这两种情况中都包含最低优先级的内在运算符）。然而，像往常一样，用括号覆盖评估顺序很容易（而且往往更清楚）。

最后，另一个可以重载的运算符是赋值（ =）。这仅当DT有指针组件时才相关，这是本文范围之外的主题。

多态

另一个与继承相关的OOP概念是多态(polymorphism)（字面上的意思为“多种形式”）。多态的主要特点是，实体可以对不同类型的数据进行操作，但类型本身在运行时是动态解析的。为了支持这个概念，我们可以区分：

• 多态变量(polymorphic variables)：这些变量可能在程序执行期间保存不同派生类型的实例。它们用于实现多态过程，也用于定义高级数据结构，如链表(linked list)（见Cormen等人[6]），它可以在不同节点中存储不同类型的数据。这些变量可以在Fortran中使用 class(<BaseClassName>)或 class(*)类型。

前者允许为变量分配BaseClassName类型的值，或任何“is a”（=继承自）BaseClassName的类型（用Fortran术语来说，我们称该变量在class BaseClassName中）。与其他OOP语言一样，可以将基类定义为abstract，这样就无法实例化该类型的变量。无论哪种方式，基类的主要目的都是对常见功能进行分组，这些功能将由Fortran class（="继承层次结构"）中的所有派生类型支持。(翻成白话：就是说，和其他OOP语言一样，需要在上层类别中定义一个抽象基类，对这个基类的方法抽象化。方法的具体实现在各个子类中具体实现）

使用类型class(*)定义变量时，它们可以被指定为任何派生类型的值（包括内置类型）。

由于其动态性质，多态变量需要是可分配的虚参(dummy arguments)或指针(pointers)。

• 多态程序(polyphorphic procedures)：在程序执行期间，这些程序可能会对不同类型的数据进行操作。其优点是，此类过程的代码可以用通用术语编写，为不同派生类型的变量调用方法。只要派生类型满足一些接口约定（多态过程发出的调用需要实际存在于被调用方的派生类型中），运行时系统就会动态地确定需要调用哪个派生类型的方法。在Fortran中，多态过程是通过使用多态变量（见上文）作为虚参来支持的。还可以根据实际参数的类型，使用select type-结构（从而支持匹配特定的派生类型或一类派生类型）采取不同的操作。

对多态性机制的更完整描述超出了本书的范围。有关更多信息，请参见Metcalf等人[8]或Clerman and Spector[5]。

Fortran多态  （摘自Chapman Fortran95_2003程序设计（第16-3例子））

    !//多态程序的应用，摘自Chapman Fortran95_2003程序设计（第16-3例子）
    !//注释，by jianglizhi
    !//实现Fortran的多态，其中，实现了类继承(extends)、重载(overload)等特性

    !//用class保留字声明的指针或者形参类型，称为指针或形参类型的声明类型(declared type) ,而分配给指针或者形参的实际对象被称为动态类型(dynamic type)
    !//因为用class保留字声明的数据项可以和一种以上的数据类型想配，所以被称为是多态的(polymorphic)
    !//多态指针或形参有一个特殊的限制：仅能用它们来访问声明类型的数据项。扩展的数据项不能用多态指针访问。

    !//定义一个超类
    module shape_class
    implicit none

    type,public :: shape
    contains
    procedure,public :: area => calc_area_fn
    procedure,public :: perimeter => calc_perimeter_fn
    procedure,public :: to_string => to_string_fn
    end type shape

    private :: calc_area_fn, calc_perimeter_fn, to_string_fn
    contains
    real function calc_area_fn(this)
    implicit none
    !//使用class关键字，这样shape子类的对象也可以使用该函数
    class(shape) :: this
    calc_area_fn = 0.
    end function calc_area_fn

    real function calc_perimeter_fn(this)
    implicit none
    class(shape) :: this
    calc_perimeter_fn =0.
    end function calc_perimeter_fn

    character(len=50) function to_string_fn(this)
    implicit none
    class(shape) :: this
    to_string_fn=''
    end function to_string_fn
    end module shape_class

!//定义一个子类
    module circle_class
    use shape_class
    implicit none

    type,public,extends(shape) :: circle
        real :: r = 0
    contains
    procedure,public :: initialize => initialize_sub
    procedure,public :: area => get_area_fn
    procedure,public :: perimeter => get_perimeter_fn
    procedure,public :: to_string => to_string_fn
    end type circle

    real,parameter :: PI = 3.141593
    private :: initialize_sub,get_area_fn,get_perimeter_fn
    private :: to_string_fn
    contains

    subroutine initialize_sub(this,r)
    implicit none
    class(circle) :: this
    real,intent(in) :: r
    this%r=r
    end subroutine initialize_sub

    real function get_area_fn(this)
    implicit none
    class(circle) :: this
    get_area_fn=PI * this%r**2
    end function get_area_fn

    real function get_perimeter_fn(this)
    implicit none
    class(circle) :: this
    get_perimeter_fn =2.0*PI*this%r
    end function get_perimeter_fn

    character(len=50) function to_string_fn(this)
    implicit none
    class(circle) :: this
    write(to_string_fn,'(A,F6.2)')'Circle of radius ',&
        this%r
    end function to_string_fn
    end module circle_class

!//定义一个子类
    module triangle_class
    use shape_class
    implicit none

    type,public,extends(shape) :: triangle
        real :: s = 0
    contains
    procedure,public :: initialize => initialize_sub
    procedure,public :: area => get_area_fn
    procedure,public :: perimeter => get_perimeter_fn
    procedure,public :: to_string => to_string_fn
    end type triangle
    private :: initialize_sub, get_area_fn, get_perimeter_fn
    private :: to_string_fn
    contains
    subroutine initialize_sub(this,s)
    implicit none
    class(triangle) :: this
    real,intent(in) :: s
    this%s = s
    end subroutine initialize_sub

    real function get_area_fn(this)
    implicit none
    class(triangle) :: this
    get_area_fn = SQRT(3.0) /4.0* this%s**2
    end function get_area_fn

    real function get_perimeter_fn(this)
    implicit none
    class(triangle) :: this
    get_perimeter_fn=3.0*this%s
    end function get_perimeter_fn

    character(len=50) function to_string_fn(this)
    implicit none
    class(triangle) :: this
    write(to_string_fn,'(A,F6.2)')'Equilaternal triangle of side ',&
        this%s
    end function to_string_fn
    end module triangle_class

!//定义一个子类
    module rectangle_class
    use shape_class
    implicit none

    type,public,EXTENDS(shape) :: rectangle
        real :: l =0
        real :: w = 0
    CONTAINS

    procedure,public :: initialize => initialize_sub
    procedure,public :: area => get_area_fn
    procedure,public :: perimeter => get_perimeter_fn
    procedure,public :: to_string => to_string_fn
    end type rectangle

    private :: initialize_sub, get_area_fn, get_perimeter_fn
    private :: to_string_fn
    contains
    subroutine initialize_sub(this,l,w)
    implicit none
    class(rectangle) :: this
    real,intent(in) :: l
    real,intent(in) :: w
    this%l = l
    this%w = w
    end subroutine initialize_sub

    real function get_area_fn(this)
    implicit none
    class(rectangle) :: this
    get_area_fn = this%l* this%w
    end function get_area_fn

    real function get_perimeter_fn(this)
    implicit none
    class(rectangle) :: this
    get_perimeter_fn=2*this%l + 2*this%w
    end function get_perimeter_fn

    character(len=50) function to_string_fn(this)
    implicit none
    class(rectangle) :: this
    write(to_string_fn,'(A,F6.2,A,F6.2)')'Rectangle of length ',&
        this%l, ' and width ', this%w
    end function to_string_fn
    end module rectangle_class

    module square_class
    use rectangle_class
    implicit none
    type,public,extends(rectangle) :: square
    contains
    procedure,public :: to_string => to_string_fn
    end type square
    private :: to_string_fn
    contains

    character(len=50) function to_string_fn(this)
    implicit none
    class(square) :: this
    write(to_string_fn,'(A,F6.2)')'Square of length ',&
        this%l
    end function to_string_fn

    end module square_class

!//定义一个子类
    module pentagon_class
    use shape_class
    implicit none

    type,public,EXTENDS(shape) :: pentagon
        real :: s =0
    CONTAINS

    procedure,public :: initialize => initialize_sub
    procedure,public :: area => get_area_fn
    procedure,public :: perimeter => get_perimeter_fn
    procedure,public :: to_string => to_string_fn
    end type pentagon

    private :: initialize_sub, get_area_fn, get_perimeter_fn
    private :: to_string_fn
    contains
    subroutine initialize_sub(this,s)
    implicit none
    class(pentagon) :: this
    real,intent(in) :: s
    this%s = s
    end subroutine initialize_sub

    real function get_area_fn(this)
    implicit none
    class(pentagon) :: this
    get_area_fn = 1.25*this%s**2 /0.72654253
    end function get_area_fn

    real function get_perimeter_fn(this)
    implicit none
    class(pentagon) :: this
    get_perimeter_fn=5.0*this%s
    end function get_perimeter_fn

    character(len=50) function to_string_fn(this)
    implicit none
    class(pentagon) :: this
    write(to_string_fn,'(A,F6.2)')'Pentagon of side ',&
        this%s
    end function to_string_fn
    end module pentagon_class

    program test_shape
    use circle_class
    use square_class
    use rectangle_class
    use triangle_class
    use pentagon_class

    implicit none
    type(circle),pointer :: cir
    type(square),pointer :: squ
    type(rectangle),pointer :: rec
    type(triangle),pointer :: tri
    type(pentagon),pointer :: pen

    integer :: i
    character(len=50) :: id_string
    integer :: istat
    type ::  shape_ptr
        class(shape),pointer :: p
    end type shape_ptr

    type(shape_ptr),dimension(5) :: shapes

    allocate(cir,stat=istat)
    call cir%initialize(2.0)

    allocate(squ,stat=istat)
    call squ%initialize(2.0,2.0)

    allocate(rec,stat=istat)
    call rec%initialize(2.0,1.0)

    allocate(tri,stat=istat)
    call tri%initialize(2.0)

    allocate(pen,stat=istat)
    call pen%initialize(2.0)

    shapes(1)%p =>cir
    shapes(2)%p =>squ
    shapes(3)%p =>rec
    shapes(4)%p =>tri
    shapes(5)%p =>pen

    do i=1,5
        id_string = shapes(i)%p%to_string()
        write(*,'(/A)') id_string
        write(*,'(A,F8.4)')'Area      = ',shapes(i)%p%area()
        write(*,'(A,F8.4)')'Perimeter = ',shapes(i)%p%perimeter()
    end do
    end program test_shape

泛型编程(Generic Programming, GP)

像C++这样的语言也支持GP，因此程序是一次编写的，而类型则在后面指定，例如Stepanov和McJONS〔11〕。这可以显著减少代码的重复；例如，可以编写一个swap-程序，编译器可以从中实例化版本，以交换整数、实数或用户定义类型的数据。目前，Fortran在一定范围内也支持其中一些想法。

Fortran泛型例子（引自 Fortran多态基础 - 简书【左志华 zuo.zhihua@qq.com】 ）

! 设置phoneCall模块
module phone_mod
  ! 代码维护者：左志华 zuo.zhihua@qq.com
  private
  ! <type> <variableName> ! 描述|用途

  type, public :: Nokia   ! Nokia结构体
  ! NONE
  end type Nokia

  type, public :: Iphone  ! Iphone结构体
  ! NONE
  end type Iphone

  interface phoneCall     ! phoneCall接口 泛型接口
      module procedure :: nokiaPhoneCall
      module procedure :: iphoneCall
  end interface phoneCall
  private :: nokiaPhoneCall, iphoneCall ! 隐藏多态实现细节
  public  :: phoneCall                  ! 向外展示多态接口
contains

  subroutine nokiaPhoneCall(n)
      type(Nokia) :: n
      print *, "I am Nokia."
  end subroutine nokiaPhoneCall

  subroutine iphoneCall(i)
      type(Iphone) :: i
      print *, "I am Iphone."
  end subroutine iphoneCall

end module phone_mod

! 主程序
program main_prog
  ! 代码维护者：左志华 zuo.zhihua@qq.com
  use phone_mod, only: &
  nokia, &
  iphone,&
  phoneCall
  ! <type> <variableName> ! 描述|用途
  type(Iphone) :: i ! Iphone实例
  type(Nokia)  :: n ! Nokia实例
  call phoneCall(i)
  call phoneCall(n)
end program main_prog

　　

元程序(elemental procedures) 首先，通过将程序变成逐元的(elemental)，可以使程序在等级上具有通用性。此类函数采用任何秩的数组（包括秩0，所以它们也支持标量），并返回形状相同的数组，但输出数组中的每个元素都包含函数应用到输入数组中相应元素的结果。当这样的逐元的（elementwisel）应用程序有意义时，它可以显著减少代码大小（因为不需要对于不同数组形状，编写特定版本的过程对于应用程序中）。以下示例演示了如何将其与Vec3d类型一起使用，以实现向量标准化：

 1 module Vec3d_class
 2   implicit none
 3   private
 4   public :: normalize ! 将元函数暴露 Expose the elemental function.
 5
 6   type, public :: Vec3d
 7      real :: mU = 0., mV = 0., mW = 0.
 8   end type Vec3d
 9
10 contains
11   type(Vec3d) elemental function normalize( this ) !定义元函数-标准化
12     type(Vec3d), intent(in) :: this
13     ! 局部变量 （注意，getMagnitude-方法同样可以被调用，但我们不需要它的实现，为了简便）
14     ! Local variable (note that the 'getMagnitude'-method could also be called, but we do not have it implemented here, for brevity).
15     real :: magnitude
16     magnitude = sqrt( this%mU**2 + this%mV**2 + this%mW**2 )
17     normalize%mU = this%mU / magnitude
18     normalize%mV = this%mV / magnitude
19     normalize%mW = this%mW / magnitude
20   end function normalize
21 end module Vec3d_class
22
23 program test_elemental
24   use Vec3d_class
25   implicit none
26
27   type(Vec3d) :: scalarIn, array1In(10), array2In(15, 20)
28   type(Vec3d) :: scalarOut, array1Out(10), array2Out(15, 20)
29
30   ! 给输入变量赋值... Place some values in the 'in'-variables...
31   scalarOut = normalize( scalarIn ) ! 对标量进行标准化 Apply normalize to scalar
32   array1Out = normalize( array1In ) ! 对一维数组进行标准化 Apply normalize to rank-1 array
33   array2Out = normalize( array2In ) ! 对二维数组进行标准化 Apply normalize to rank-2 array
34 end program test_elemental

Listing 3.43 src/Chapter3/dt_elemental_normalization.f90

将过程编写成逐元的程序不仅可以使其通用，还可以提高性能。后者是因为elemental程序也需要是pure的（我们在第3.2.5节中描述了这个主题）；满足此限制后，无论函数以何种顺序（串行/并行）应用于输入元素，都可以保证获得正确的结果。许多内置函数都是逐元的。

参数化类型(Parameterized types) 在Fortran中，可以基于整数值参数化数据类型。然后，这些参数的特定值可以在编译时（也称为kind-like参数，因为它们可以用于改变内置类型的精度）或在运行时（也称为len-like参数，以突出显示与运行时指定的长度字符串的连接）分配。有关这一更高级功能的讨论，请参见Metcalf等人[8]。