chap09/kadai5.f90

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

  1module mod_rational
  2  implicit none
  3  private
  4
  5  type :: rational
  6    integer :: num, den
  7  endtype rational
  8
  9  interface operator(+)
 10    module procedure add
 11  endinterface operator(+)
 12
 13  interface operator(-)
 14    module procedure sub
 15  endinterface operator(-)
 16
 17  interface operator(*)
 18    module procedure mul
 19  endinterface operator(*)
 20
 21  interface operator(/)
 22    module procedure div
 23  endinterface operator(/)
 24
 25  interface assignment(=)
 26    module procedure assign
 27  endinterface assignment(=)
 28
 29  public :: rational
 30  public :: show
 31  public :: operator(+), operator(-), operator(*), operator(/), assignment(=)
 32
 33contains
 34
 35  function add(a, b) result(ret)
 36    implicit none
 37    type(rational), intent(in) :: a, b
 38    type(rational) :: ret
 39
 40    ret % num = a % num * b % den + a % den * b % num
 41    ret % den = a % den * b % den
 42    call reduction(ret % num, ret % den)
 43
 44  endfunction add
 45
 46  function sub(a, b) result(ret)
 47    implicit none
 48    type(rational), intent(in) :: a, b
 49    type(rational) :: ret
 50
 51    ret % num = a % num * b % den - a % den * b % num
 52    ret % den = a % den * b % den
 53    call reduction(ret % num, ret % den)
 54
 55  endfunction sub
 56
 57  function mul(a, b) result(ret)
 58    implicit none
 59    type(rational), intent(in) :: a, b
 60    type(rational) :: ret
 61
 62    ret % num = a % num * b % num
 63    ret % den = a % den * b % den
 64    call reduction(ret % num, ret % den)
 65
 66  endfunction mul
 67
 68  function div(a, b) result(ret)
 69    implicit none
 70    type(rational), intent(in) :: a, b
 71    type(rational) :: ret
 72
 73    ret % num = a % num * b % den
 74    ret % den = a % den * b % num
 75    call reduction(ret % num, ret % den)
 76
 77  endfunction div
 78
 79  subroutine assign(a, b)
 80    implicit none
 81    type(rational), intent(out) :: a
 82    integer, intent(in) :: b(2)
 83
 84    a % num = b(1)
 85    a % den = b(2)
 86    call reduction(a % num, a % den)
 87
 88  endsubroutine assign
 89
 90  subroutine show(r)
 91    implicit none
 92    type(rational), intent(in) :: r
 93
 94    write(*, '(i6, " / ", i6)') r % num, r % den
 95    return
 96  endsubroutine show
 97
 98  function gcd(a, b) result(ret)
 99    implicit none
100    integer, intent(in) :: a, b
101    integer :: ret
102
103    integer :: r, m, n
104
105    m = a
106    n = b
107    r = mod(m, n)
108    do while(r /= 0)
109      m = n
110      n = r
111      r = mod(m, n)
112    enddo
113
114    ret = abs(n)
115
116  endfunction gcd
117
118  subroutine reduction(num, den)
119    implicit none
120    integer, intent(inout) :: num, den
121
122    integer :: r
123
124    r = gcd(num, den)
125    num = num / r
126    den = den / r
127  endsubroutine reduction
128
129endmodule mod_rational
130
131program answer
132  use mod_rational
133  implicit none
134
135  type(rational) :: a, b
136
137  a = (/1, 4/)
138  b = (/2, 5/)
139
140  write(*, fmt='(a)', advance='no') 'a     = '
141  call show(a)
142
143  write(*, fmt='(a)', advance='no') 'b     = '
144  call show(b)
145
146  write(*, fmt='(a)', advance='no') 'a + b = '
147  call show(a + b)
148
149  write(*, fmt='(a)', advance='no') 'a - b = '
150  call show(a - b)
151
152  write(*, fmt='(a)', advance='no') 'a * b = '
153  call show(a * b)
154
155  write(*, fmt='(a)', advance='no') 'a / b = '
156  call show(a / b)
157
158  stop
159endprogram answer