Fortran
オブジェクト指向プログラミング

派生型定義

Fortran 2003はオブジェクト指向プログラミングのサポートを導入しました。この機能により、最新のプログラミング手法を利用できます。派生型は、次の形式で定義されます。

TYPE [[, attr-list] :: ] name [(name-list)]
   [def-stmts]
   [PRIVATE statement or SEQUENCE statement]. . .
   [component-definition]. . .
   [procedure-part]
END TYPE [name]

ここで、

• attr-list - 属性指定子のリスト
• name - 派生データ型の名前
• name-list - カンマで区切られた型パラメータ名のリスト
• def-stmts - name-listに指定された型パラメータの1つ以上のINTEGER宣言
• コンポーネント定義 - 派生型のコンポーネントを定義する1つ以上の型宣言文または手続きポインタ文
• procedure-part - CONTAINS文、オプションでPRIVATE文、および1つ以上のプロシージャ・バインディング文

例：

type shape
    integer :: color
end type shape

タイプ手続き

クラスのような振る舞いを得るためには、型と関連する手続き（サブルーチンと関数）がモジュールに置かれなければならない：

例：

module MShape
    implicit none
    private

    type, public :: Shape
    private
        integer :: radius
    contains
        procedure :: set   => shape_set_radius
        procedure :: print => shape_print
    end type Shape

contains
    subroutine shape_set_radius(this, value)
        class(Shape), intent(in out) :: self
        integer, intent(in)          :: value

        self%radius = value
    end subroutine shape_set_radius

    subroutine shape_print(this)
        class(Shape), intent(in) :: self

        print *, 'Shape: r = ', self%radius
    end subroutine shape_print
end module MShape

後で、コードでは、このShapeクラスを次のように使用できます。

! declare a variable of type Shape
type(Shape) :: shape

! call the type-bound subroutine
call shape%set(10)
call shape%print 

抽象派生型

拡張可能な派生型は、 抽象型であってもよい

type, abstract :: base_type
end type

そのような派生型は、

type(base_type) t1
allocate(type(base_type) :: t2)

多相オブジェクトは宣言された型としてこれを持つかもしれません

class(base_type), allocatable :: t1

または

function f(t1)
  class(base_type) t1
end function

抽象型は、コンポーネントと型に束縛された手続きを持つことがあります

type, abstract :: base_type
  integer i
contains
  procedure func
  procedure(func_iface), deferred :: def_func
end type

プロシージャdef_funcは、インタフェースfunc_iface持つ遅延型バインド・プロシージャfunc_iface 。このような遅延型バインドプロシージャは、各拡張型によって実装されなければならない。

タイプ拡張

派生型は、 bind属性もsequence属性も持たない場合は拡張可能です。このようなタイプは、別のタイプによって拡張されてもよい。

module mod

  type base_type
    integer i
  end type base_type

  type, extends(base_type) :: higher_type
    integer j
  end type higher_type

end module mod

宣言型と多型変数base_type型と互換性のある型でhigher_type 、そのような動的型を有していてもよいです

class(base_type), allocatable :: obj
allocate(obj, source=higher_type(1,2))

型互換性は、一連の子を介して下降しますが、型は1つの他の型だけに拡張できます。

拡張された派生型は、親から型バインドされたプロシージャを継承しますが、これはオーバーライドできます

module mod

  type base_type
  contains
    procedure :: sub => sub_base
  end type base_type

  type, extends(base_type) :: higher_type
  contains
    procedure :: sub => sub_higher
  end type higher_type

contains

  subroutine sub_base(this)
    class(base_type) this
  end subroutine sub_base

  subroutine sub_higher(this)
    class(higher_type) this
  end subroutine sub_higher

end module mod

program prog
  use mod

  class(base_type), allocatable :: obj

  obj = base_type()
  call obj%sub

  obj = higher_type()
  call obj%sub

end program

型コンストラクタ

インターフェイスを使用して型名をオーバーロードすることによって、派生型のカスタムコンストラクタを作成できます。このようにして、その型のオブジェクトを構築するときに、コンポーネントに対応しないキーワード引数を使用することができます。

module ball_mod
  implicit none

  ! only export the derived type, and not any of the
  ! constructors themselves
  private
  public :: ball

  type :: ball_t
     real :: mass
  end type ball_t

  ! Writing an interface overloading 'ball_t' allows us to
  ! overload the type constructor
  interface ball_t
     procedure :: new_ball
  end interface ball_t

contains

  type(ball_t) function new_ball(heavy)
    logical, intent(in) :: heavy

    if (heavy) then
       new_ball%mass = 100
    else
       new_ball%mass = 1
    end if
    
  end function new_ball
  
end module ball_mod

program test
  use ball_mod
  implicit none

  type(ball_t) :: football
  type(ball_t) :: boulder
  
  ! sets football%mass to 4.5
  football = ball_t(4.5)
  ! calls 'ball_mod::new_ball'
  boulder = ball_t(heavy=.true.)
end program test

これは、別々の初期化ルーチンを使用するよりもきめ細かなAPIを作成するために使用できます。

subroutine make_heavy_ball(ball)
  type(ball_t), intent(inout) :: ball
  ball%mass = 100
end subroutine make_heavy_ball

...

call make_heavy_ball(boulder)