1program answer
2 implicit none
3
4 real(8) :: a, b, c, d, x1, x2, y1, y2, e1, e2, e3, e4
5
6 write(*, fmt='(a)', advance='no') 'Input coefficients (a, b, c) : '
7 read(*, *) a, b, c
8
9 if(b**2 < 4 * a * c) then
10 write(*, *) 'No real solutions'
11 stop
12 endif
13
14 d = sqrt(b**2 - 4 * a * c)
15
16 ! 普通に求めた解および規格化された誤差
17 x1 = (-b + d) / (2 * a)
18 x2 = (-b - d) / (2 * a)
19
20 e1 = (a * x1**2 + b * x1 + c) / max(a * x1**2, b * x1, c)
21 e2 = (a * x2**2 + b * x2 + c) / max(a * x2**2, b * x2, c)
22
23 ! 桁落ち対策
24 if(b * d > 0) then
25 ! x1の精度が悪い可能性有り
26 y1 = 2 * c / (-b - d)
27 y2 = x2
28 else
29 ! x2の精度が悪い可能性有り
30 y1 = x1
31 y2 = 2 * c / (-b + d)
32 endif
33
34 write(*, fmt='("roots without correction = ", e24.16, 3x, e24.16)') x1, x2
35 write(*, fmt='("roots with correction = ", e24.16, 3x, e24.16)') y1, y2
36
37 stop
38endprogram answer