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是一個內置操作符，從而簡單地實現這一點。如下所示：

module Vec3d_class
  implicit none

  type, public :: Vec3d
     real :: mU = 0., mV = 0., mW = 0. ! Make 'private' in practice!
   contains
     procedure :: display ! Convenience output-method.
  end type Vec3d

  ! 用於運算符重載的泛型接口
  interface operator(-) 19      module procedure negate   ! 一元負號
     module procedure subtract ! 二元減號
  end interface operator(-)

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 
  ! 注意：也可以用異構數據類型重載二進制運算符。
  ! 在我們的例子中，我們可以為二元的“-”再設置兩個重載，
  ! 以便在inVec1或inVec2是標量時支持減法。
  ! 在這種情況下，只需更改inVec1或inVec2的類型，並調整函數中的代碼。
  !
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 
  ! 工具方法，用於更方便的展示'Vec3d'元素
  ! 注：一個更好的解決方式是使用派生類型的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多態基礎 - 簡書【左志華 [e-mail]】 ）

! 設置phoneCall模塊
module phone_mod
  ! 代碼維護者：左志華 [e-mail]
  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
  ! 代碼維護者：左志華 [e-mail]
  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]。