chap08/sample3.f90

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

 1program sample
 2  implicit none
 3
 4  integer, parameter :: nmax = 20
 5  real(8), parameter :: tolerance = 1.0e-6
 6
 7  logical :: status
 8  integer :: n
 9  real(8) :: x, y, dx, dy
10
11  write(*, fmt='(a)', advance='no') 'Input a initial guess : '
12  read(*, *) x
13
14  status = .false.
15  do n = 1, nmax
16    ! 次の値の推定
17    y = f(x)
18    dy = df(x)
19    dx = -y / dy
20    x = x + dx
21
22    ! 収束判定
23    if(abs(dx) < tolerance) then
24      status = .true.
25      write(*, fmt='("Converged at step ", i4)') n
26      exit
27    else
28      write(*, fmt='("Error at step ", i4, " = ", e20.8)') n, abs(y)
29    endif
30  enddo
31
32  ! 結果の表示
33  if(.not. status) then
34    write(*, fmt='("Failed to find a root after ", i3, " iterations")') nmax
35  endif
36
37  write(*, fmt='("Final approximation = ", e20.8)') x
38  write(*, fmt='("Final error         = ", e20.8)') abs(y)
39
40  stop
41contains
42  ! 方程式
43  function f(x) result(ret)
44    implicit none
45    real(8), intent(in) :: x
46    real(8) :: ret
47
48    ret = x - cos(x)
49
50    return
51  endfunction f
52
53  ! 方程式の微分
54  function df(x) result(ret)
55    implicit none
56    real(8), intent(in) :: x
57    real(8) :: ret
58
59    ret = 1.0_8 + sin(x)
60
61    return
62  endfunction df
63
64endprogram sample