1program answer
2 implicit none
3
4 real(8) :: x
5
6 read(*, *) x
7
8 write(*, *) 'sqrt(x) = ', sqrt(x)
9 write(*, *) 'appox = ', mysqrt(x)
10
11 stop
12contains
13 !
14 ! 逐次近似で平方根を求める
15 !
16 function mysqrt(x) result(y)
17 implicit none
18 real(8), intent(in) :: x
19 real(8) :: y
20
21 real(8), parameter :: epsilon = 1.0e-5
22 real(8) :: xx, err
23
24 ! 初期値
25 y = x
26 err = 1.0_8
27
28 do while(err > epsilon)
29 xx = y
30 y = 0.5_8 * (x / xx + xx)
31 err = abs((xx - y) / xx)
32 enddo
33
34 endfunction mysqrt
35endprogram answer