chap09/sample5.f90

サンプルコードのダウンロード

  1! ベクトルモジュール
  2module mod_vector
  3  implicit none
  4  private
  5
  6  ! 2次元のベクトル
  7  type :: vector2
  8    real(8) :: x, y
  9  endtype vector2
 10
 11  ! + 演算子のオーバーロード
 12  interface operator(+)
 13    module procedure add2, add2_scalar1, add2_scalar2
 14  endinterface operator(+)
 15
 16  ! - 演算子のオーバーロード
 17  interface operator(-)
 18    module procedure sub2
 19  endinterface operator(-)
 20
 21  ! = 演算子のオーバーロード
 22  interface assignment(=)
 23    module procedure assign2
 24  endinterface assignment(=)
 25
 26  ! 表示サブルーチンのオーバーロード
 27  interface show
 28    module procedure show2
 29  endinterface show
 30
 31  ! 公開
 32  public :: vector2
 33  public :: show, operator(+), operator(-), assignment(=)
 34
 35contains
 36  ! + 演算子の中身
 37  function add2(a, b) result(ret)
 38    implicit none
 39    type(vector2), intent(in) :: a, b
 40    type(vector2) :: ret
 41
 42    ret % x = a % x + b % x
 43    ret % y = a % y + b % y
 44  endfunction add2
 45
 46  ! + 演算子の中身: vector2 + scalar
 47  function add2_scalar1(a, b) result(ret)
 48    implicit none
 49    type(vector2), intent(in) :: a
 50    real(8), intent(in) :: b
 51    type(vector2) :: ret
 52
 53    ret % x = a % x + b
 54    ret % y = a % y + b
 55  endfunction add2_scalar1
 56
 57  ! + 演算子の中身: scalar + vector2
 58  function add2_scalar2(a, b) result(ret)
 59    implicit none
 60    real(8), intent(in) :: a
 61    type(vector2), intent(in) :: b
 62    type(vector2) :: ret
 63
 64    ret % x = a + b % x
 65    ret % y = a + b % y
 66  endfunction add2_scalar2
 67
 68  ! - 演算子の中身
 69  function sub2(a, b) result(ret)
 70    implicit none
 71    type(vector2), intent(in) :: a, b
 72    type(vector2) :: ret
 73
 74    ret % x = a % x - b % x
 75    ret % y = a % y - b % y
 76  endfunction sub2
 77
 78  ! = 演算子の中身
 79  subroutine assign2(a, b)
 80    implicit none
 81    type(vector2), intent(out) :: a ! intent(out) に注意
 82    real(8), intent(in) :: b ! intent(in)  に注意
 83
 84    ! どちらも同じ値
 85    a % x = b
 86    a % y = b
 87  endsubroutine assign2
 88
 89  ! 表示
 90  subroutine show2(v)
 91    implicit none
 92    type(vector2), intent(in) :: v
 93
 94    write(*, '("vector2 : ", f10.4, ",", f10.4)') v % x, v % y
 95    return
 96  endsubroutine show2
 97
 98endmodule mod_vector
 99
100! vectorモジュールを使うサンプル
101program sample
102  use mod_vector
103  implicit none
104
105  type(vector2) :: a, b, c, d
106
107  a % x = 1.0_8
108  a % y = 0.0_8
109
110  call show(a + 1.0_8)  ! add2_scalar1の呼び出し
111  call show(0.5_8 + a)  ! add2_scalar2の呼び出し
112
113  ! 以下は単精度実数に対する演算が定義されていないのでエラー
114  !call show(0.5 + a)
115
116  ! 代入演算子を用いる
117  b = 1.0_8
118
119  call show(a)
120  call show(b)
121
122  c = a + b
123  call show(c)
124
125  d = a - b
126  call show(d)
127
128  stop
129endprogram sample